From 4d9b1b815db84a939b0ebdb8b30a913409bce820 Mon Sep 17 00:00:00 2001 From: Colin Campbell Date: Wed, 26 Nov 2014 12:52:36 +0000 Subject: [PATCH] Bug 7736 Edifact QUOTE, ORDER and INVOICE handling Handle Electronic Ordering via Edifact Messages This commits adds files to allow interfacing with book suppliers using Edifact Messages Currently this supports transferring files by ftp or sftp There is also an option to read/write to a local directory which may be useful for testing or other scenarios Quote messages are used to create baskets in Koha and will create the associated bib and item records if required If the user chooses to generate an edifact order from a basket an Edifact format message is created for submission If receiving an Invoice Message a corresponding invoice is created in Koha and the order is receipted Suppliers interfaces need to be properly configured to send the correct budget, item type etc info For more info on Edifact Formats see http://www.editeur.org/31/Library-Book-Supply --- C4/Acquisition.pm | 6 +- C4/Installer/PerlDependencies.pm | 10 + Koha/EDI.pm | 541 ++++++++++++++ Koha/Edifact.pm | 335 +++++++++ Koha/Edifact/Line.pm | 577 ++++++++++++++ Koha/Edifact/Message.pm | 255 +++++++ Koha/Edifact/Order.pm | 832 +++++++++++++++++++++ Koha/Edifact/Segment.pm | 210 ++++++ Koha/Edifact/Transport.pm | 470 ++++++++++++ Koha/Schema/Result/Aqbasket.pm | 19 +- Koha/Schema/Result/Aqbookseller.pm | 34 +- Koha/Schema/Result/Aqbudget.pm | 19 +- Koha/Schema/Result/Aqinvoice.pm | 32 +- Koha/Schema/Result/Branch.pm | 21 +- Koha/Schema/Result/EdifactEan.pm | 91 +++ Koha/Schema/Result/EdifactMessage.pm | 202 +++++ Koha/Schema/Result/MsgInvoice.pm | 115 +++ Koha/Schema/Result/VendorEdiAccount.pm | 233 ++++++ acqui/basket.pl | 78 ++ acqui/basketgroup.pl | 17 + acqui/edi_ean.pl | 64 ++ acqui/edifactmsgs.pl | 55 ++ acqui/edimsg.pl | 72 ++ acqui/invoices.pl | 4 +- admin/edi_accounts.pl | 153 ++++ admin/edi_ean_accounts.pl | 158 ++++ .../data/mysql/en/mandatory/userpermissions.sql | 1 + installer/data/mysql/kohastructure.sql | 70 +- installer/data/mysql/sysprefs.sql | 1 + installer/data/mysql/updatedatabase.pl | 80 ++ .../prog/en/includes/acquisitions-menu.inc | 3 + .../intranet-tmpl/prog/en/includes/admin-menu.inc | 2 + .../intranet-tmpl/prog/en/modules/acqui/basket.tt | 34 +- .../prog/en/modules/acqui/basketgroup.tt | 2 + .../intranet-tmpl/prog/en/modules/acqui/edi_ean.tt | 38 + .../prog/en/modules/acqui/edifactmsgs.tt | 86 +++ .../intranet-tmpl/prog/en/modules/acqui/edimsg.tt | 35 + .../prog/en/modules/admin/admin-home.tt | 4 + .../prog/en/modules/admin/edi_accounts.tt | 265 +++++++ .../prog/en/modules/admin/edi_ean_accounts.tt | 153 ++++ .../prog/en/modules/tools/tools-home.tt | 5 + misc/cronjobs/edi_cron.pl | 111 +++ t/BLSINV337023.CEI | 1 + t/EdiInvoice.t | 75 ++ t/Edifact.t | 90 +++ t/Ediorder.t | 56 ++ t/prquotes_73050_20140430.CEQ | 1 + 47 files changed, 5701 insertions(+), 15 deletions(-) create mode 100644 Koha/EDI.pm create mode 100644 Koha/Edifact.pm create mode 100644 Koha/Edifact/Line.pm create mode 100644 Koha/Edifact/Message.pm create mode 100644 Koha/Edifact/Order.pm create mode 100644 Koha/Edifact/Segment.pm create mode 100644 Koha/Edifact/Transport.pm create mode 100644 Koha/Schema/Result/EdifactEan.pm create mode 100644 Koha/Schema/Result/EdifactMessage.pm create mode 100644 Koha/Schema/Result/MsgInvoice.pm create mode 100644 Koha/Schema/Result/VendorEdiAccount.pm create mode 100755 acqui/edi_ean.pl create mode 100755 acqui/edifactmsgs.pl create mode 100755 acqui/edimsg.pl create mode 100755 admin/edi_accounts.pl create mode 100755 admin/edi_ean_accounts.pl create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt create mode 100644 koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt create mode 100755 misc/cronjobs/edi_cron.pl create mode 100644 t/BLSINV337023.CEI create mode 100755 t/EdiInvoice.t create mode 100755 t/Edifact.t create mode 100755 t/Ediorder.t create mode 100644 t/prquotes_73050_20140430.CEQ diff --git a/C4/Acquisition.pm b/C4/Acquisition.pm index 22934e9..171fee6 100644 --- a/C4/Acquisition.pm +++ b/C4/Acquisition.pm @@ -2566,6 +2566,10 @@ sub GetInvoices { push @bind_strs, " borrowers.branchcode = ? "; push @bind_args, $args{branchcode}; } + if($args{message_id}) { + push @bind_strs, " aqinvoices.message_id = ? "; + push @bind_args, $args{message_id}; + } $query .= " WHERE " . join(" AND ", @bind_strs) if @bind_strs; $query .= " GROUP BY aqinvoices.invoiceid "; @@ -2686,7 +2690,7 @@ sub AddInvoice { return unless(%invoice and $invoice{invoicenumber}); my @columns = qw(invoicenumber booksellerid shipmentdate billingdate - closedate shipmentcost shipmentcost_budgetid); + closedate shipmentcost shipmentcost_budgetid message_id); my @set_strs; my @set_args; diff --git a/C4/Installer/PerlDependencies.pm b/C4/Installer/PerlDependencies.pm index 96557e3..a0acc94 100644 --- a/C4/Installer/PerlDependencies.pm +++ b/C4/Installer/PerlDependencies.pm @@ -737,6 +737,16 @@ our $PERL_DEPS = { 'required' => '0', 'min_ver' => '5.61', }, + 'Net::SFTP::Foreign' => { + 'usage' => 'Edifact', + 'required' => '0', + 'min_ver' => '1.73', + }, + 'Log::Log4perl' => { + 'usage' => 'Edifact', + 'required' => '0', + 'min_ver' => '1.29', + }, }; 1; diff --git a/Koha/EDI.pm b/Koha/EDI.pm new file mode 100644 index 0000000..d1346cf --- /dev/null +++ b/Koha/EDI.pm @@ -0,0 +1,541 @@ +package Koha::EDI; + +# Copyright 2014 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 base qw(Exporter); +use Carp; +use English qw{ -no_match_vars }; +use Business::ISBN; +use DateTime; +use C4::Context; +use Koha::Database; +use C4::Acquisition qw( NewBasket AddInvoice ModReceiveOrder ); +use C4::Items qw(AddItem); +use C4::Biblio qw( AddBiblio TransformKohaToMarc GetMarcBiblio ); +use Koha::Edifact::Order; +use Koha::Edifact; +use Log::Log4perl; + +our $VERSION = 1.1; +our @EXPORT_OK = + qw( process_quote process_invoice create_edi_order get_edifact_ean ); + +sub create_edi_order { + my $parameters = shift; + my $basketno = $parameters->{basketno}; + my $ean = $parameters->{ean}; + my $branchcode = $parameters->{branchcode}; + my $noingest = $parameters->{noingest}; + $ean ||= C4::Context->preference('EDIfactEAN'); + if ( !$basketno || !$ean ) { + carp 'create_edi_order called with no basketno or ean'; + return; + } + + my $database = Koha::Database->new(); + my $schema = $database->schema(); + + my @orderlines = $schema->resultset('Aqorder')->search( + { + basketno => $basketno, + orderstatus => 'new', + } + )->all; + + my $vendor = $schema->resultset('VendorEdiAccount')->search( + { + vendor_id => $orderlines[0]->basketno->booksellerid->id, + } + )->single; + + my $ean_search_keys = { ean => $ean, }; + if ($branchcode) { + $ean_search_keys->{branchcode} = $branchcode; + } + my $ean_obj = + $schema->resultset('EdifactEan')->search($ean_search_keys)->single; + + my $edifact = Koha::Edifact::Order->new( + { orderlines => \@orderlines, vendor => $vendor, ean => $ean_obj } ); + if ( !$edifact ) { + return; + } + + my $order_file = $edifact->encode(); + + # ingest result + if ($order_file) { + if ($noingest) { # allows scripts to produce test files + return $order_file; + } + my $order = { + message_type => 'ORDERS', + raw_msg => $order_file, + vendor_id => $vendor->vendor_id, + status => 'Pending', + basketno => $basketno, + filename => $edifact->filename(), + transfer_date => $edifact->msg_date_string(), + edi_acct => $vendor->id, + + }; + $schema->resultset('EdifactMessage')->create($order); + return 1; + } + + return; +} + +sub process_invoice { + my $invoice_message = shift; + my $database = Koha::Database->new(); + my $schema = $database->schema(); + my $vendor_acct; + my $logger = Log::Log4perl->get_logger(); + my $edi = + Koha::Edifact->new( { transmission => $invoice_message->raw_msg, } ); + my $messages = $edi->message_array(); + if ( @{$messages} ) { + + # BGM contains an invoice number + foreach my $msg ( @{$messages} ) { + my $invoicenumber = $msg->docmsg_number(); + my $shipmentcharge = $msg->shipment_charge(); + my $msg_date = $msg->message_date; + my $tax_date = $msg->tax_point_date; + if ( !defined $tax_date || $tax_date !~ m/^\d{8}/xms ) { + $tax_date = $msg_date; + } + + my $vendor_ean = $msg->supplier_ean; + if ( !defined $vendor_acct || $vendor_ean ne $vendor_acct->san ) { + $vendor_acct = $schema->resultset('VendorEdiAccount')->search( + { + san => $vendor_ean, + } + )->single; + } + if ( !$vendor_acct ) { + carp +"Cannot find vendor with ean $vendor_ean for invoice $invoicenumber in $invoice_message->filename"; + next; + } + $invoice_message->edi_acct( $vendor_acct->id ); + $logger->trace("Adding invoice:$invoicenumber"); + my $invoiceid = AddInvoice( + invoicenumber => $invoicenumber, + booksellerid => $invoice_message->vendor_id, + shipmentdate => $msg_date, + billingdate => $tax_date, + shipmentcost => $shipmentcharge, + shipmentcost_budgetid => $vendor_acct->shipment_budget, + message_id => $invoice_message->id, + ); + $logger->trace("Added as invoiceno :$invoiceid"); + my $lines = $msg->lineitems(); + + foreach my $line ( @{$lines} ) { + my $ordernumber = $line->ordernumber; + $logger->trace( "Receipting order:$ordernumber Qty: ", + $line->quantity ); + + # handle old basketno/ordernumber references + if ( $ordernumber =~ m{\d+\/(\d+)}xms ) { + $ordernumber = $1; + } + my $order = $schema->resultset('Aqorder')->find($ordernumber); + + # ModReceiveOrder does not validate that $ordernumber exists validate here + if ($order) { + ModReceiveOrder( + { + biblionumber => $order->biblionumber, + ordernumber => $ordernumber, + quantityreceived => $line->quantity, + cost => $line->price_net, + invoiceid => $invoicenumber, + datereceived => $msg_date, + received_itemnumbers => [], + } + ); + } + else { + $logger->error( + "No order found for $ordernumber Invoice:$invoicenumber" + ); + next; + } + + } + + } + } + + $invoice_message->status('received'); + $invoice_message->update; # status and basketno link + return; +} + +# called on messages with status 'new' +sub process_quote { + my $quote = shift; + + my $edi = Koha::Edifact->new( { transmission => $quote->raw_msg, } ); + my $messages = $edi->message_array(); + my $process_errors = 0; + my $logger = Log::Log4perl->get_logger(); + my $database = Koha::Database->new(); + my $schema = $database->schema(); + + if ( @{$messages} && $quote->vendor_id ) { + my $basketno = + NewBasket( $quote->vendor_id, 0, $quote->filename, q{}, q{} . q{} ); + $quote->basketno($basketno); + $logger->trace("Created basket :$basketno"); + for my $msg ( @{$messages} ) { + my $items = $msg->lineitems(); + my $refnum = $msg->message_refno; + + for my $item ( @{$items} ) { + if ( !quote_item( $schema, $item, $quote, $basketno ) ) { + ++$process_errors; + } + } + } + } + my $status = 'received'; + if ($process_errors) { + $status = 'error'; + } + + $quote->status($status); + $quote->update; # status and basketno link + + return; +} + +sub quote_item { + my ( $schema, $item, $quote, $basketno ) = @_; + + # create biblio record + my $logger = Log::Log4perl->get_logger(); + my $bib_hash = { + 'biblioitems.cn_source' => 'ddc', + 'items.cn_source' => 'ddc', + 'items.notforloan' => -1, + 'items.cn_sort' => q{}, + }; + my $item_hash = { + cn_source => 'ddc', + notforloan => -1, + cn_dort => q{}, + }; + $bib_hash->{'biblio.seriestitle'} = $item->series; + + $bib_hash->{'biblioitems.publishercode'} = $item->publisher; + $bib_hash->{'biblioitems.publicationyear'} = + $bib_hash->{'biblio.copyrightdate'} = $item->publication_date; + + $bib_hash->{'biblio.title'} = $item->title; + $bib_hash->{'biblio.author'} = $item->author; + $bib_hash->{'biblioitems.isbn'} = $item->item_number_id; + $bib_hash->{'biblioitems.itemtype'} = $item->girfield('stock_category'); + $item_hash->{booksellerid} = $quote->vendor_id; + $item_hash->{price} = $item_hash->{replacementprice} = $item->price; + $item_hash->{itype} = $item->girfield('stock_category'); + $item_hash->{location} = $item->girfield('collection_code'); + + my $budget = _get_budget( $schema, $item->girfield('fund_allocation') ); + + if ( !$budget ) { + carp 'Skipping line with no budget info'; + $logger->trace('line skipped for invalid budget'); + return; + } + + my $note = {}; + + my $shelfmark = + $item->girfield('shelfmark') || $item->girfield('classification') || q{}; + $item_hash->{itemcallnumber} = $shelfmark; + my $branch = $item->girfield('branch'); + $item_hash->{holdingbranch} = $item_hash->{homebranch} = $branch; + for my $key ( keys %{$bib_hash} ) { + if ( !defined $bib_hash->{$key} ) { + delete $bib_hash->{$key}; + } + } + my $bib_record = TransformKohaToMarc($bib_hash); + + $logger->trace( 'Checking db for matches with ', $item->item_number_id() ); + my $bib = _check_for_existing_bib( $item->item_number_id() ); + if ( !defined $bib ) { + $bib = {}; + ( $bib->{biblionumber}, $bib->{biblioitemnumber} ) = + AddBiblio( $bib_record, q{} ); + $logger->trace("New biblio added $bib->{biblionumber}"); + } + else { + $logger->trace("Match found: $bib->{biblionumber}"); + } + + my $order_note = $item->{free_text}; + $order_note ||= q{}; + if ( !$basketno ) { + $logger->error('Skipping order creation no basketno'); + return; + } + + # database definitions should set some of these defaults but dont + my $order_hash = { + biblionumber => $bib->{biblionumber}, + entrydate => DateTime->now( time_zone => 'local' )->ymd(), + quantity => $item->quantity, + basketno => $basketno, + listprice => $item->price, + quantityreceived => 0, + + # notes => $order_note, becane internalnote in 3.15 + order_internalnote => $order_note, + rrp => $item->price, + ecost => _discounted_price( $quote->vendor->discount, $item->price ), + budget_id => $budget->budget_id, + uncertainprice => 0, + sort1 => q{}, + sort2 => q{}, + supplierreference => $item->reference, + }; + if ( $item->girfield('servicing_instruction') ) { + + # not in 3.14 !!! + $order_hash->{order_vendornote} = + $item->girfield('servicing_instruction'); + } + if ( $item->internal_notes() ) { + if ( $order_hash->{order_internalnote} ) { # more than '' + $order_hash->{order_internalnote} .= q{ }; + } + + $order_hash->{order_internalnote} .= $item->internal_notes; + } + + my $new_order = $schema->resultset('Aqorder')->create($order_hash); + my $o = $new_order->ordernumber(); + $logger->trace("Order created :$o"); + + # should be done by database settings + $new_order->parent_ordernumber( $new_order->ordernumber() ); + $new_order->update(); + + if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { + my $itemnumber; + ( $bib->{biblionumber}, $bib->{biblioitemnumber}, $itemnumber ) = + AddItem( $item_hash, $bib->{biblionumber} ); + $logger->trace("Added item:$itemnumber"); + $schema->resultset('AqordersItem')->create( + { + ordernumber => $new_order->ordernumber, + itemnumber => $itemnumber, + } + ); + + if ( $item->quantity > 1 ) { + my $occurence = 1; + while ( $occurence < $item->quantity ) { + my $new_item = { + notforloan => -1, + cn_sort => q{}, + cn_source => 'ddc', + price => $item->price, + replacementprice => $item->price, + itype => $item->girfield( 'stock_category', $occurence ), + location => + $item->girfield( 'collection_code', $occurence ), + itemcallnumber => $item->girfield( 'shelfmark', $occurence ) + || $item->girfield( 'classification', $occurence ), + holdingbranch => $item->girfield( 'branch', $occurence ), + homebranch => $item->girfield( 'branch', $occurence ), + }; + ( undef, undef, $itemnumber ) = + AddItem( $new_item, $bib->{biblionumber} ); + $logger->trace("New item $itemnumber added"); + $schema->resultset('AqordersItem')->create( + { + ordernumber => $new_order->ordernumber, + itemnumber => $itemnumber, + } + ); + ++$occurence; + } + } + + } + return 1; +} + +sub get_edifact_ean { + + my $dbh = C4::Context->dbh; + + my $eans = $dbh->selectcol_arrayref('select ean from edifact_ean'); + + return $eans->[0]; +} + +# We should not need to have a routine to do this here +sub _discounted_price { + my ( $discount, $price ) = @_; + return $price - ( ( $discount * $price ) / 100 ); +} + +sub _check_for_existing_bib { + my $isbn = shift; + + my $search_isbn = $isbn; + $search_isbn =~ s/^\s*/%/xms; + $search_isbn =~ s/\s*$/%/xms; + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare( +'select biblionumber, biblioitemnumber from biblioitems where isbn like ?', + ); + my $tuple_arr = + $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn ); + if ( @{$tuple_arr} ) { + return $tuple_arr->[0]; + } + else { + undef $search_isbn; + $isbn =~ s/\-//xmsg; + if ( $isbn =~ m/(\d{13})/xms ) { + my $b_isbn = Business::ISBN->new($1); + if ( $b_isbn && $b_isbn->is_valid ) { + $search_isbn = $b_isbn->as_isbn10->as_string( [] ); + } + + } + elsif ( $isbn =~ m/(\d{9}[xX]|\d{10})/xms ) { + my $b_isbn = Business::ISBN->new($1); + if ( $b_isbn && $b_isbn->is_valid ) { + $search_isbn = $b_isbn->as_isbn13->as_string( [] ); + } + + } + if ($search_isbn) { + $search_isbn = "%$search_isbn%"; + $tuple_arr = + $dbh->selectall_arrayref( $sth, { Slice => {} }, $search_isbn ); + if ( @{$tuple_arr} ) { + return $tuple_arr->[0]; + } + } + } + return; +} + +# returns a budget obj or undef +# fact we need this shows what a mess Acq API is +sub _get_budget { + my ( $schema, $budget_code ) = @_; + + # db does not ensure budget code is unque + return $schema->resultset('Aqbudget')->single( + { + budget_code => $budget_code, + } + ); +} + +1; +__END__ + +=head1 NAME + Koha::EDI + +=head1 SYNOPSIS + + Module exporting subroutines used in EDI processing for Koha + +=head1 DESCRIPTION + + Subroutines called by batch processing to handle Edifact + messages of various types and related utilities + +=head1 BUGS + + These routines should really be methods of some object. + get_edifact_ean is a stopgap which should be replaced + +=head1 SUBROUTINES + +=head2 process_quote + + process_quote(quote_message); + + passed a message object for a quote, parses it creating an order basket + and orderlines in the database + updates the message's status to received in the database and adds the + link to basket + +=head2 process_invoice + + process_invoice(invoice_message) + + passed a message object for an invoice, add the contained invoices + and update the orderlines referred to in the invoice + As an Edifact invoice is in effect a despatch note this receipts the + appropriate quantities in the orders + + +=head2 create_edi_order + + create_edi_order( { parameter_hashref } ) + + parameters must include basketno and ean + + branchcode can optionally be passed + + returns 1 on success undef otherwise + + if the parameter noingest is set the formatted order is returned + and not saved in the database. This functionality is intended for debugging only + +=head2 get_edifact_ean + + +=head2 quote_item + + quote_item(lineitem, quote_message); + + Called by process_quote to handle an individual lineitem + Generate the biblios and items if required and orderline linking to them + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact.pm b/Koha/Edifact.pm new file mode 100644 index 0000000..3ee6b19 --- /dev/null +++ b/Koha/Edifact.pm @@ -0,0 +1,335 @@ +package Koha::Edifact; + +# Copyright 2014 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 File::Slurp; +use Carp; +use Encode qw( from_to ); +use Koha::Edifact::Segment; +use Koha::Edifact::Message; + +my $separator = { + component => q{\:}, + data => q{\+}, + decimal => q{.}, + release => q{\?}, + reserved => q{ }, + segment => q{\'}, +}; + +sub new { + my ( $class, $param_hashref ) = @_; + my $transmission; + my $self = (); + + if ( $param_hashref->{filename} ) { + if ( $param_hashref->{transmission} ) { + carp +"Cannot instantiate $class : both filename and transmission passed"; + return; + } + $transmission = read_file( $param_hashref->{filename} ); + } + else { + $transmission = $param_hashref->{transmission}; + } + $self->{transmission} = _init($transmission); + + bless $self, $class; + return $self; +} + +sub interchange_header { + my ( $self, $field ) = @_; + + my %element = ( + sender => 1, + recipient => 2, + datetime => 3, + interchange_control_reference => 4, + application_reference => 6, + ); + if ( !exists $element{$field} ) { + carp "No interchange header field $field available"; + return; + } + my $data = $self->{transmission}->[0]->elem( $element{$field} ); + return $data; +} + +sub interchange_trailer { + my ( $self, $field ) = @_; + my $trailer = $self->{transmission}->[-1]; + if ( $field eq 'interchange_control_count' ) { + return $trailer->elem(0); + } + elsif ( $field eq 'interchange_control_reference' ) { + return $trailer->elem(1); + } + carp "Trailer field $field not recognized"; + return; +} + +sub new_data_iterator { + my $self = shift; + my $offset = 0; + while ( $self->{transmission}->[$offset]->tag() ne 'UNH' ) { + ++$offset; + if ( $offset == @{ $self->{transmission} } ) { + carp 'Cannot find message start'; + return; + } + } + $self->{data_iterator} = $offset; + return 1; +} + +sub next_segment { + my $self = shift; + if ( defined $self->{data_iterator} ) { + my $seg = $self->{transmission}->[ $self->{data_iterator} ]; + if ( $seg->tag eq 'UNH' ) { + + $self->{msg_type} = $seg->elem( 1, 0 ); + } + elsif ( $seg->tag eq 'LIN' ) { + $self->{msg_type} = 'detail'; + } + + if ( $seg->tag ne 'UNZ' ) { + $self->{data_iterator}++; + } + else { + $self->{data_iterator} = undef; + } + return $seg; + } + return; +} + +# for debugging return whole transmission +sub get_transmission { + my $self = shift; + + return $self->{transmission}; +} + +sub message_type { + my $self = shift; + return $self->{msg_type}; +} + +sub _init { + my $msg = shift; + if ( !$msg ) { + return; + } + if ( $msg =~ s/^UNA(.{6})// ) { + if ( service_string_advice($1) ) { + return segmentize($msg); + + } + return; + } + else { + my $s = substr $msg, 10; + croak "File does not start with a Service string advice :$s"; + } +} + +# return an array of message data which will be used to +# create Message objects +sub message_array { + my $self = shift; + + # return an array of array_refs 1 ref to a message + my $msg_arr = []; + my $msg = []; + my $in_msg = 0; + foreach my $seg ( @{ $self->{transmission} } ) { + if ( $seg->tag eq 'UNH' ) { + $in_msg = 1; + push @{$msg}, $seg; + } + elsif ( $seg->tag eq 'UNT' ) { + $in_msg = 0; + if ( @{$msg} ) { + push @{$msg_arr}, Koha::Edifact::Message->new($msg); + $msg = []; + } + } + elsif ($in_msg) { + push @{$msg}, $seg; + } + } + return $msg_arr; +} + +# +# internal parsing routines used in _init +# +sub service_string_advice { + my $ssa = shift; + + # At present this just validates that the ssa + # is standard Edifact + # TBD reset the seps if non standard + if ( $ssa ne q{:+.? '} ) { + carp " Non standard Service String Advice [$ssa]"; + return; + } + + # else use default separators + return 1; +} + +sub segmentize { + my $raw = shift; + + # In practice edifact uses latin-1 but check + # Transport now converts to utf-8 on ingest + # Do not convert here + #my $char_set = 'iso-8859-1'; + #if ( $raw =~ m/^UNB[+]UNO(.)/ ) { + # $char_set = msgcharset($1); + #} + #from_to( $raw, $char_set, 'utf8' ); + + my $re = qr{ +(?> # dont backtrack into this group + [?]. # either the escape character + # followed by any other character + | # or + [^'?] # a character that is neither escape + # nor split + )+ +}x; + my @segmented; + while ( $raw =~ /($re)/g ) { + push @segmented, Koha::Edifact::Segment->new( { seg_string => $1 } ); + } + return \@segmented; +} + +sub msgcharset { + my $code = shift; + if ( $code =~ m/^[^ABCDEF]$/ ) { + $code = 'default'; + } + my %encoding_map = ( + A => 'ascii', + B => 'ascii', + C => 'iso-8859-1', + D => 'iso-8859-1', + E => 'iso-8859-1', + F => 'iso-8859-1', + default => 'iso-8859-1', + ); + return $encoding_map{$code}; +} + +1; +__END__ + +=head1 NAME + Koha::Edifact + +=head1 SYNOPSIS + +=head1 DESCRIPTION + + Koha module for parsing Edifact messages + +=head1 BUGS + + +=head1 SUBROUTINES + +=head2 new + + my $e = Koha::Edifact->new( { filename => 'myfilename' } ); + or + my $e = Koha::Edifact->new( { transmission => $msg_variable } ); + + instantiate the Edifact parser, requires either to be passed an in-memory + edifact message as transmission or a filename which it will read on creation + +=head2 interchange_header + + will return the data in the header field designated by the parameter + specified. Valid parameters are: 'sender', 'recipient', 'datetime', + 'interchange_control_reference', and 'application_reference' + +=head2 interchange_trailer + + called either with the string 'interchange_control_count' or + 'interchange_control_reference' will return the corresponding field from + the interchange trailer + +=head2 new_data_iterator + + Sets the object's data_iterator to point to the UNH segment +=head2 next_segment + + Returns the next segment pointed to by the data_iterator. Increments the + data_iterator member or destroys it if segment UNZ has been reached + +=head2 get_transmission + + This method is useful in debugg:ing. Call on an Edifact it returns + the object's transmission member + +=head2 message_type + + return the object's message type + +=head2 message_array + + return an array of Message objects contained in the Edifact transmission + +=head1 Internal Methods + +=head2 service_string_advice + + Examines the Service String Advice returns 1 if the default separartors are in use + undef otherwise + +=head2 segmentize + + takes a raw Edifact message and returns a reference to an array of + its segments + +=head2 msgcharset + + Return the character set the message was encoded in. The default is iso-8859-1 + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Line.pm b/Koha/Edifact/Line.pm new file mode 100644 index 0000000..a017f39 --- /dev/null +++ b/Koha/Edifact/Line.pm @@ -0,0 +1,577 @@ +package Koha::Edifact::Line; + +# Copyright 2014 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 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 $d = { + line_item_number => $lin->elem(0), + item_number_id => $lin->elem( 2, 0 ), + 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' ) { + $d->{avaiability_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); + + } + elsif ( $s->tag eq 'FTX' ) { + + my $type = $s->elem(1); + if ( $type eq 'LNO' ) { # Ingrams Oasis Internal Notes field + $type = 'internal_notes'; + } + else { + $type = 'free_text'; + } + + my $ftx = $s->elem(3); + if ( ref $ftx eq 'ARRAY' ) { # it comes in 70 character components + $ftx = join ' ', @{$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 linenumber + $d->{reference} = $s->elem( 0, 1 ); + } + elsif ( $qualifier eq 'LI' ) { # Buyer's unique orderline number + $d->{ordernumber} = $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 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 ordernumber { + my $self = shift; + return $self->{ordernumber}; +} + +sub free_text { + my $self = shift; + return $self->{free_text}; +} + +sub internal_notes { + my $self = shift; + return $self->{internal_notes}; +} + +# 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} ) { + return $self->{item_description}->{$field}; + } + 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 girfield { + my ( $self, $field, $occ ) = @_; + + # defaults to occurence 0 returns undef if occ requested > occs + if ( defined $occ && $occ > @{ $self->{GIR} } ) { + return; + } + $occ ||= 0; + return $self->{GIR}->[$occ]->{$field}; +} + +sub extract_gir { + my $s = shift; + my %qmap = ( + LAC => 'barcode', + LCL => 'classification', + LFN => 'fund_allocation', + LLN => 'loan_category', + LLO => 'branch', + LSM => 'shelfmark', + LSQ => 'collection_code', + LST => 'stock_category', + LVT => 'servicing_instruction', + LCO => 'item_unique_id', + ); + + 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'); +} + +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('146'); +} + +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'); +} + +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 + + +=head1 Methods + +=head2 new + + Called with an array ref of segments constituting the line + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Message.pm b/Koha/Edifact/Message.pm new file mode 100644 index 0000000..5c79c4e --- /dev/null +++ b/Koha/Edifact/Message.pm @@ -0,0 +1,255 @@ +package Koha::Edifact::Message; + +# Copyright 2014 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 Koha::Edifact::Line; + +sub new { + my ( $class, $data_array_ref ) = @_; + my $header = shift @{$data_array_ref}; + my $bgm = shift @{$data_array_ref}; + my $msg_function = $bgm->elem(2); + my $dtm = []; + while ( $data_array_ref->[0]->tag eq 'DTM' ) { + push @{$dtm}, shift @{$data_array_ref}; + } + + my $self = { + function => $msg_function, + header => $header, + bgm => $bgm, + message_reference_number => $header->elem(0), + dtm => $dtm, + datasegs => $data_array_ref, + }; + + bless $self, $class; + return $self; +} + +sub message_refno { + my $self = shift; + return $self->{message_reference_number}; +} + +sub function { + my $self = shift; + my $msg_function = $self->{bgm}->elem(2); + if ( $msg_function == 9 ) { + return 'original'; + } + elsif ( $msg_function == 7 ) { + return 'retransmission'; + } + return; +} + +sub message_reference_number { + my $self = shift; + return $self->{header}->elem(0); +} + +sub message_type { + my $self = shift; + return $self->{header}->elem( 1, 0 ); +} + +sub message_code { + my $self = shift; + return $self->{bgm}->elem( 0, 0 ); +} + +sub docmsg_number { + my $self = shift; + return $self->{bgm}->elem(1); +} + +sub message_date { + my $self = shift; + + # usually the first if not only dtm + foreach my $d ( @{ $self->{dtm} } ) { + if ( $d->elem( 0, 0 ) eq '137' ) { + return $d->elem( 0, 1 ); + } + } + return; # this should not happen +} + +sub tax_point_date { + my $self = shift; + if ( $self->message_type eq 'INVOIC' ) { + foreach my $d ( @{ $self->{dtm} } ) { + if ( $d->elem( 0, 0 ) eq '131' ) { + return $d->elem( 0, 1 ); + } + } + } + return; +} + +sub expiry_date { + my $self = shift; + if ( $self->message_type eq 'QUOTES' ) { + foreach my $d ( @{ $self->{dtm} } ) { + if ( $d->elem( 0, 0 ) eq '36' ) { + return $d->elem( 0, 1 ); + } + } + } + return; +} + +sub shipment_charge { + my $self = shift; + + # A large number of different charges can be expressed at invoice and + # item level but the only one koha takes cognizance of is shipment + # should we wrap all invoice level charges into it?? + if ( $self->message_type eq 'INVOIC' ) { + my $delivery = 0; + my $amt = 0; + foreach my $s ( @{ $self->{datasegs} } ) { + if ( $s->tag eq 'LIN' ) { + last; + } + if ( $s->tag eq 'ALC' ) { + if ( $s->elem(0) eq 'C' ) { # Its a charge + if ( $s->elem( 4, 0 ) eq 'DL' ) { # delivery charge + $delivery = 1; + } + } + next; + } + if ( $s->tag eq 'MOA' ) { + $amt += $s->elem( 0, 1 ); + } + } + return $amt; + } + return; +} + +# return NAD fields + +sub buyer_ean { + my $self = shift; + foreach my $s ( @{ $self->{datasegs} } ) { + if ( $s->tag eq 'LIN' ) { + last; + } + if ( $s->tag eq 'NAD' ) { + my $qualifier = $s->elem(0); + if ( $qualifier eq 'BY' ) { + return $s->elem( 1, 0 ); + } + } + } + return; +} + +sub supplier_ean { + my $self = shift; + foreach my $s ( @{ $self->{datasegs} } ) { + if ( $s->tag eq 'LIN' ) { + last; + } + if ( $s->tag eq 'NAD' ) { + my $qualifier = $s->elem(0); + if ( $qualifier eq 'SU' ) { + return $s->elem( 1, 0 ); + } + } + } + return; + +} + +sub lineitems { + my $self = shift; + if ( $self->{quotation_lines} ) { + return $self->{quotation_lines}; + } + else { + my $items = []; + my $item_arr = []; + foreach my $seg ( @{ $self->{datasegs} } ) { + my $tag = $seg->tag; + if ( $tag eq 'LIN' ) { + if ( @{$item_arr} ) { + push @{$items}, Koha::Edifact::Line->new($item_arr); + } + $item_arr = [$seg]; + next; + } + elsif ( $tag =~ m/^(UNS|CNT|UNT)$/sxm ) { + if ( @{$item_arr} ) { + push @{$items}, Koha::Edifact::Line->new($item_arr); + } + last; + } + else { + if ( @{$item_arr} ) { + push @{$item_arr}, $seg; + } + } + } + $self->{quotation_lines} = $items; + return $items; + } +} + +1; +__END__ + +=head1 NAME + Koha::Edifact::Message + +=head1 SYNOPSIS + + +=head1 DESCRIPTION + +Class modelling an Edifact Message for parsing + +=head1 BUGS + + +=head1 METHODS + +=head2 new + + Passed an array of segments extracts message level info + and parses lineitems as Line objects + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Order.pm b/Koha/Edifact/Order.pm new file mode 100644 index 0000000..9185268 --- /dev/null +++ b/Koha/Edifact/Order.pm @@ -0,0 +1,832 @@ +package Koha::Edifact::Order; + +use strict; +use warnings; + +# Copyright 2014 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 Carp; +use DateTime; +use Readonly; +use Business::ISBN; +use Encode qw(from_to); +use Koha::Database; +use C4::Budgets qw( GetBudget ); + +Readonly::Scalar my $seg_terminator => q{'}; +Readonly::Scalar my $separator => q{+}; +Readonly::Scalar my $component_separator => q{:}; +Readonly::Scalar my $release_character => q{?}; + +Readonly::Scalar my $NINES_12 => 999_999_999_999; +Readonly::Scalar my $NINES_14 => 99_999_999_999_999; +Readonly::Scalar my $CHUNKSIZE => 35; + +my $use_marc_based_description = + 0; # A global configflag : not currently implemented + +sub new { + my ( $class, $parameter_hashref ) = @_; + + my $self = {}; + if ( ref $parameter_hashref ) { + $self->{orderlines} = $parameter_hashref->{orderlines}; + $self->{recipient} = $parameter_hashref->{vendor}; + $self->{sender} = $parameter_hashref->{ean}; + + # convenient alias + $self->{basket} = $self->{orderlines}->[0]->basketno; + $self->{message_date} = DateTime->now( time_zone => 'local' ); + } + + # validate that its worth proceeding + if ( !$self->{orderlines} ) { + carp 'No orderlines passed to create order'; + return; + } + if ( !$self->{recipient} ) { + carp +"No vendor passed to order creation: basket = $self->{basket}->basketno()"; + return; + } + if ( !$self->{sender} ) { + carp +"No sender ean passed to order creation: basket = $self->{basket}->basketno()"; + return; + } + + # do this once per object not once per orderline + my $database = Koha::Database->new(); + $self->{schema} = $database->schema; + + bless $self, $class; + return $self; +} + +sub filename { + my $self = shift; + if ( !$self->{orderlines} ) { + return; + } + my $filename = 'ordr' . $self->{basket}->basketno; + $filename .= '.CEP'; + return $filename; +} + +sub encode { + my ($self) = @_; + + $self->{interchange_control_reference} = int rand($NINES_14); + $self->{message_count} = 0; + + # $self->{segs}; # Message segments + + $self->{transmission} = q{}; + + $self->{transmission} .= $self->initial_service_segments(); + + $self->{transmission} .= $self->user_data_message_segments(); + + $self->{transmission} .= $self->trailing_service_segments(); + return $self->{transmission}; +} + +sub msg_date_string { + my $self = shift; + return $self->{message_date}->ymd(); +} + +sub initial_service_segments { + my $self = shift; + + #UNA service string advice - specifies standard separators + my $segs = _const('service_string_advice'); + + #UNB interchange header + $segs .= $self->interchange_header(); + + #UNG functional group header NOT USED + return $segs; +} + +sub interchange_header { + my $self = shift; + + # syntax identifier + my $hdr = + 'UNB+UNOC:3'; # controling agency character set syntax version number + # Interchange Sender + $hdr .= _interchange_sr_identifier( $self->{sender}->ean, + $self->{sender}->id_code_qualifier ); # interchange sender + $hdr .= _interchange_sr_identifier( $self->{recipient}->san, + $self->{recipient}->id_code_qualifier ); # interchange Recipient + + $hdr .= $separator; + + # DateTime of preparation + $hdr .= $self->{message_date}->format_cldr('yyMMdd:HHmm'); + $hdr .= $separator; + $hdr .= $self->interchange_control_reference(); + $hdr .= $separator; + + # Recipents reference password not usually used in edifact + $hdr .= q{+ORDERS}; # application reference + +#Edifact does not usually include the following +# $hdr .= $separator; # Processing priority not usually used in edifact +# $hdr .= $separator; # Acknowledgewment request : not usually used in edifact +# $hdr .= q{+EANCOM} # Communications agreement id +# $hdr .= q{+1} # Test indicator +# + $hdr .= $seg_terminator; + return $hdr; +} + +sub user_data_message_segments { + my $self = shift; + + #UNH message_header :: seg count begins here + $self->message_header(); + + $self->order_msg_header(); + + my $line_number = 0; + foreach my $ol ( @{ $self->{orderlines} } ) { + ++$line_number; + $self->order_line( $line_number, $ol ); + } + + $self->message_trailer(); + + my $data_segment_string = join q{}, @{ $self->{segs} }; + return $data_segment_string; +} + +sub message_trailer { + my $self = shift; + + # terminate the message + $self->add_seg("UNS+S$seg_terminator"); + + # CNT Control_Total + # Could be (code 1) total value of QTY segments + # or ( code = 2 ) number of lineitems + my $num_orderlines = @{ $self->{orderlines} }; + $self->add_seg("CNT+2:$num_orderlines$seg_terminator"); + + # UNT Message Trailer + my $segments_in_message = + 1 + @{ $self->{segs} }; # count incl UNH & UNT (!!this one) + my $reference = $self->message_reference('current'); + $self->add_seg("UNT+$segments_in_message+$reference$seg_terminator"); + return; +} + +sub trailing_service_segments { + my $self = shift; + my $trailer = q{}; + + #UNE functional group trailer NOT USED + #UNZ interchange trailer + $trailer .= $self->interchange_trailer(); + + return $trailer; +} + +sub interchange_control_reference { + my $self = shift; + if ( $self->{interchange_control_reference} ) { + return sprintf '%014d', $self->{interchange_control_reference}; + } + else { + carp 'calling for ref of unencoded order'; + return 'NONE ASSIGNED'; + } +} + +sub message_reference { + my ( $self, $function ) = @_; + if ( $function eq 'new' || !$self->{message_reference_no} ) { + + # unique 14 char mesage ref + $self->{message_reference_no} = sprintf 'ME%012d', int rand($NINES_12); + } + return $self->{message_reference_no}; +} + +sub message_header { + my $self = shift; + + $self->{segs} = []; # initialize the message + $self->{message_count}++; # In practice alwaya 1 + + my $hdr = q{UNH+} . $self->message_reference('new'); + $hdr .= _const('message_identifier'); + $self->add_seg($hdr); + return; +} + +sub interchange_trailer { + my $self = shift; + + my $t = "UNZ+$self->{message_count}+"; + $t .= $self->interchange_control_reference; + $t .= $seg_terminator; + return $t; +} + +sub order_msg_header { + my $self = shift; + my @header; + + # UNH see message_header + # BGM + push @header, beginning_of_message( $self->{basket}->basketno ); + + # DTM + push @header, message_date_segment( $self->{message_date} ); + + # NAD-RFF buyer supplier ids + push @header, + name_and_address( + 'BUYER', + $self->{sender}->ean, + $self->{sender}->id_code_qualifier + ); + push @header, + name_and_address( + 'SUPPLIER', + $self->{recipient}->san, + $self->{recipient}->id_code_qualifier + ); + + # repeat for for other relevant parties + + # CUX currency + # ISO 4217 code to show default currency prices are quoted in + # e.g. CUX+2:GBP:9' + # TBD currency handling + + $self->add_seg(@header); + return; +} + +sub beginning_of_message { + my $basketno = shift; + my $document_message_no = sprintf '%011d', $basketno; + + # my $message_function = 9; # original 7 = retransmission + # message_code values + # 220 prder + # 224 rush order + # 228 sample order :: order for approval / inspection copies + # 22C continuation order for volumes in a set etc. + # my $message_code = '220'; + + return "BGM+220+$document_message_no+9$seg_terminator"; +} + +sub name_and_address { + my ( $party, $id_code, $id_agency ) = @_; + my %qualifier_code = ( + BUYER => 'BY', + DELIVERY => 'DP', # delivery location if != buyer + INVOICEE => 'IV', # if different from buyer + SUPPLIER => 'SU', + ); + if ( !exists $qualifier_code{$party} ) { + carp "No qualifier code for $party"; + return; + } + if ( $id_agency eq '14' ) { + $id_agency = '9'; # ean coded differently in this seg + } + + return "NAD+$qualifier_code{$party}+${id_code}::$id_agency$seg_terminator"; +} + +sub order_line { + my ( $self, $linenumber, $orderline ) = @_; + + my $schema = $self->{schema}; + my $biblionumber = $orderline->biblionumber->biblionumber; + my @biblioitems = $schema->resultset('Biblioitem') + ->search( { biblionumber => $biblionumber, } ); + my $biblioitem = $biblioitems[0]; # makes the assumption there is 1 only + # or else all have same details + + # LIN line-number in msg :: if we had a 13 digit ean we could add + $self->add_seg( lin_segment( $linenumber, $biblioitem->isbn ) ); + + # PIA isbn or other id + $self->add_seg( additional_product_id( $biblioitem->isbn ) ); + + # IMD biblio description + if ($use_marc_based_description) { + + # get marc from biblioitem->marc + + # $ol .= marc_item_description($orderline->{bib_description}); + } + else { # use brief description + $self->add_seg( + item_description( $orderline->biblionumber, $biblioitem ) ); + } + + # QTY order quantity + my $qty = join q{}, 'QTY+21:', $orderline->quantity, $seg_terminator; + $self->add_seg($qty); + + # DTM Optional date constraints on delivery + # we dont currently support this in koha + # GIR copy-related data + my @items; + if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { + my @linked_itemnumbers = $orderline->aqorders_items; + + foreach my $item (@linked_itemnumbers) { + my $i_obj = $schema->resultset('Item')->find( $item->itemnumber ); + if ( defined $i_obj ) { + push @items, $i_obj; + } + } + } + else { + my $item_hash = { + itemtype => $biblioitem->itemtype, + shelfmark => $biblioitem->cn_class, + }; + my $branch = $orderline->basketno->branch->branchcode; + if ($branch) { + $item_hash->{branch} = $branch; + } + for ( 1 .. $orderline->quantity ) { + push @items, $item_hash; + } + } + my $budget = GetBudget( $orderline->budget_id ); + my $ol_fields = { budget_code => $budget->{budget_code}, }; + if ( $orderline->order_vendornote ) { + $ol_fields->{servicing_instruction} = $orderline->order_vendornote; + } + $self->add_seg( gir_segments( $ol_fields, @items ) ); + + # TBD what if #items exceeds quantity + + # FTX free text for current orderline TBD + # dont really have a special instructions field to encode here + # Encode notes here + # PRI-CUX-DTM unit price on which order is placed : optional + # Coutts read this as 0.00 if not present + if ( $orderline->listprice ) { + my $price = sprintf 'PRI+AAE:%.2f:CA', $orderline->listprice; + $price .= $seg_terminator; + $self->add_seg($price); + } + + # RFF unique orderline reference no + my $rff = join q{}, 'RFF+LI:', $orderline->ordernumber, $seg_terminator; + $self->add_seg($rff); + + # LOC-QTY multiple delivery locations + #TBD to specify extra delivery locs + # NAD order line name and address + #TBD Optionally indicate a name & address or order originator + # TDT method of delivey ol-specific + # TBD requests a special delivery option + + return; +} + +# ??? Use the IMD MARC +sub marc_based_description { + + # this includes a much larger number of fields + return; +} + +sub item_description { + my ( $bib, $biblioitem ) = @_; + my $bib_desc = { + author => $bib->author, + title => $bib->title, + publisher => $biblioitem->publishercode, + year => $biblioitem->publicationyear, + }; + + my @itm = (); + + # 009 Author + # 050 Title :: title + # 080 Vol/Part no + # 100 Edition statement + # 109 Publisher :: publisher + # 110 place of pub + # 170 Date of publication :: year + # 220 Binding :: binding + my %code = ( + author => '009', + title => '050', + publisher => '109', + year => '170', + binding => '220', + ); + for my $field (qw(author title publisher year binding )) { + if ( $bib_desc->{$field} ) { + my $data = encode_text( $bib_desc->{$field} ); + push @itm, imd_segment( $code{$field}, $data ); + } + } + + return @itm; +} + +sub imd_segment { + my ( $code, $data ) = @_; + + my $seg_prefix = "IMD+L+$code+:::"; + + # chunk_line + my @chunks; + while ( my $x = substr $data, 0, $CHUNKSIZE, q{} ) { + if ( length $x == $CHUNKSIZE ) { + if ( $x =~ s/([?]{1,2})$// ) { + $data = "$1$data"; # dont breakup ?' ?? etc + } + } + push @chunks, $x; + } + my @segs; + my $odd = 1; + foreach my $c (@chunks) { + if ($odd) { + push @segs, "$seg_prefix$c"; + } + else { + $segs[-1] .= ":$c$seg_terminator"; + } + $odd = !$odd; + } + if ( @segs && $segs[-1] !~ m/$seg_terminator$/o ) { + $segs[-1] .= $seg_terminator; + } + return @segs; +} + +sub gir_segments { + my ( $orderfields, @onorderitems ) = @_; + + my $budget_code = $orderfields->{budget_code}; + my @segments; + my $sequence_no = 1; + foreach my $item (@onorderitems) { + my $seg = sprintf 'GIR+%03d', $sequence_no; + $seg .= add_gir_identity_number( 'LFN', $budget_code ); + if ( C4::Context->preference('AcqCreateItem') eq 'ordering' ) { + $seg .= + add_gir_identity_number( 'LLO', $item->homebranch->branchcode ); + $seg .= add_gir_identity_number( 'LST', $item->itype ); + $seg .= add_gir_identity_number( 'LSQ', $item->location ); + $seg .= add_gir_identity_number( 'LSM', $item->itemcallnumber ); + + # itemcallnumber -> shelfmark + } + else { + if ( $item->{branch} ) { + $seg .= add_gir_identity_number( 'LLO', $item->{branch} ); + } + $seg .= add_gir_identity_number( 'LST', $item->{itemtype} ); + $seg .= add_gir_identity_number( 'LSM', $item->{shelfmark} ); + } + if ( $orderfields->{servicing_instruction} ) { + $seg .= add_gir_identity_number( 'LVT', + $orderfields->{servicing_instruction} ); + } + $sequence_no++; + push @segments, $seg; + } + return @segments; +} + +sub add_gir_identity_number { + my ( $number_qualifier, $number ) = @_; + if ($number) { + return "+${number}:${number_qualifier}"; + } + return q{}; +} + +sub add_seg { + my ( $self, @s ) = @_; + foreach my $segment (@s) { + if ( $segment !~ m/$seg_terminator$/o ) { + $segment .= $seg_terminator; + } + } + push @{ $self->{segs} }, @s; + return; +} + +sub lin_segment { + my ( $line_number, $isbn ) = @_; + my $isbn_string = q||; + if ($isbn) { + if ( $isbn =~ m/(978\d{10})/ ) { + $isbn = $1; + } + elsif ( $isbn =~ m/(\d{9}[\dxX])/ ) { + $isbn = $1; + } + else { + undef $isbn; + } + if ($isbn) { + my $b_isbn = Business::ISBN->new($isbn); + if ( $b_isbn->is_valid ) { + $isbn = $b_isbn->as_isbn13->isbn; + $isbn_string = "++$isbn:EN"; + } + } + } + return "LIN+$line_number$isbn_string$seg_terminator"; +} + +sub additional_product_id { + my $isbn_field = shift; + my ( $product_id, $product_code ); + if ( $isbn_field =~ m/(\d{13})/ ) { + $product_id = $1; + $product_code = 'EN'; + } + elsif ( $isbn_field =~ m/(\d{9})[Xx\d]/ ) { + $product_id = $1; + $product_code = 'IB'; + } + + # TBD we could have a manufacturers no issn etc + if ( !$product_id ) { + return; + } + + # function id set to 5 states this is the main product id + return "PIA+5+$product_id:$product_code$seg_terminator"; +} + +sub message_date_segment { + my $dt = shift; + + # qualifier:message_date:format_code + + my $message_date = $dt->ymd(q{}); # no sep in edifact format + + return "DTM+137:$message_date:102$seg_terminator"; +} + +sub _const { + my $key = shift; + Readonly my %S => { + service_string_advice => q{UNA:+.? '}, + message_identifier => q{+ORDERS:D:96A:UN:EAN008'}, + }; + return ( $S{$key} ) ? $S{$key} : q{}; +} + +sub _interchange_sr_identifier { + my ( $identification, $qualifier ) = @_; + + if ( !$identification ) { + $identification = 'RANDOM'; + $qualifier = '92'; + carp 'undefined identifier'; + } + + # 14 EAN International + # 31B US SAN (preferred) + # also 91 assigned by supplier + # also 92 assigned by buyer + if ( $qualifier !~ m/^(?:14|31B|91|92)/xms ) { + $qualifier = '92'; + } + + return "+$identification:$qualifier"; +} + +sub encode_text { + my $string = shift; + if ($string) { + from_to( $string, 'utf8', 'iso-8859-1' ); + $string =~ s/[?]/??/g; + $string =~ s/'/?'/g; + $string =~ s/:/?:/g; + $string =~ s/[+]/?+/g; + } + return $string; +} + +1; +__END__ + +=head1 NAME + Koha::Edifact::Order + +=head1 SYNOPSIS + +Format an Edifact Order message from a Koha basket + +=head1 DESCRIPTION + + +Generates an Edifact format Order message for a Koha basket. +Normally the only methods used directly by the caller would be +new to set up the message, encode to return the formatted message +and filename to obtain a name under which to store the message + + +=head1 BUGS + +Should integrate into Koha::Edifact namespace +Can caller interface be made cleaner? +Make handling of GIR segments more customizable + + +=head1 METHODS + +=head2 new + + my $edi_order = Edifact::Order->new( + orderlines => \@orderlines, + vendor => $vendor_edi_account, + ean => $library_ean + ); + + instantiate the Edifact::Order object, all parameters are Schema::Resultset objects + Called in Koha::Edifact create_edi_order + +=head2 filename + + my $filename = $edi_order->filename() + + returns a filename for the edi order. The filename embeds a reference to the + basket the message was created to encode + +=head2 encode + + my $edifact_message = $edi_order->encode(); + + Encodes the basket as a valid edifact message ready for transmission + +=head2 initial_service_segments + + Creates the service segments which begin the message + +=head2 interchange_header + + Return an interchange header encoding sender and recipient + ids message date and standards + +=head2 user_data_message_segments + + Include message data within the encoded message + +=head2 message_trailer + + Terminate message data including control data on number + of messages and segments included + +=head2 trailing_service_segments + + Include the service segments occuring at the end of the message +=head2 interchange_control_reference + + Returns the unique interchange control reference as a 14 digit number + +=head2 message_reference + + On generates and subsequently returns the unique message + reference number as a 12 digit number preceded by ME, to generate a new number + pass the string 'new'. + In practice we encode 1 message per transmission so there is only one message + referenced. were we to encode multiple messages a new reference would be + neaded for each + +=head2 message_header + + Commences a new message + +=head2 interchange_trailer + + returns the UNZ segment which ends the tranmission encoding the + message count and control reference for the interchange + +=head2 order_msg_header + + Formats the message header segments + +=head2 beginning_of_message + + Returns the BGM segment which includes the Koha basket number + +=head2 name_and_address + + Parameters: Function ( BUYER, DELIVERY, INVOICE, SUPPLIER) + Id + Agency + + Returns a NAD segment containg the id and agency for for the Function + value. Handles the fact that NAD segments encode the value for 'EAN' differently + to elsewhere. + +=head2 order_line + + Creates the message segments wncoding an order line + +=head2 marc_based_description + + Not yet implemented - To encode the the bibliographic info + as MARC based IMD fields has the potential of encoding a wider range of info + +=head2 item_description + + Encodes the biblio item fields Author, title, publisher, date of publication + binding + +=head2 imd_segment + + Formats an IMD segment, handles the chunking of data into the 35 character + lengths required and the creation of repeat segments + +=head2 gir_segments + + Add item level information + +=head2 add_gir_identity_number + + Handle the formatting of a GIR element + return empty string if no data + +=head2 add_seg + + Adds a parssed array of segments to the objects segment list + ensures all segments are properly terminated by ' + +=head2 lin_segment + + Adds a LIN segment consisting of the line number and the ean number + if the passed isbn is valid + +=head2 additional_product_id + + Add a PIA segment for an additional product id + +=head2 message_date_segment + + Passed a DateTime object returns a correctly formatted DTM segment + +=head2 _const + + Stores and returns constant strings for service_string_advice + and message_identifier + TBD replace with class variables + +=head2 _interchange_sr_identifier + + Format sender and receipient identifiers for use in the interchange header + +=head2 encode_text + + Encode textual data into the standard character set ( iso 8859-1 ) + and quote any Edifact metacharacters + +=head2 msg_date_string + + Convenient routine which returns message date as a Y-m-d string + useful if the caller wants to log date of creation + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Segment.pm b/Koha/Edifact/Segment.pm new file mode 100644 index 0000000..ead768b --- /dev/null +++ b/Koha/Edifact/Segment.pm @@ -0,0 +1,210 @@ +package Koha::Edifact::Segment; + +# Copyright 2014 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; + +sub new { + my ( $class, $parm_ref ) = @_; + my $self = {}; + if ( $parm_ref->{seg_string} ) { + $self = _parse_seg( $parm_ref->{seg_string} ); + } + + bless $self, $class; + return $self; +} + +sub tag { + my $self = shift; + return $self->{tag}; +} + +# return specified element may be data or an array ref if components +sub elem { + my ( $self, $element_number, $component_number ) = @_; + if ( $element_number < @{ $self->{elem_arr} } ) { + + my $e = $self->{elem_arr}->[$element_number]; + if ( defined $component_number ) { + if ( ref $e eq 'ARRAY' ) { + if ( $component_number < @{$e} ) { + return $e->[$component_number]; + } + } + elsif ( $component_number == 0 ) { + + # a string could be an element with a single component + return $e; + } + return; + } + else { + return $e; + } + } + return; #element undefined ( out of range +} + +sub element { + my ( $self, @params ) = @_; + + return $self->elem(@params); +} + +sub as_string { + my $self = shift; + + my $string = $self->{tag}; + foreach my $e ( @{ $self->{elem_arr} } ) { + $string .= q|+|; + if ( ref $e eq 'ARRAY' ) { + $string .= join q{:}, @{$e}; + } + else { + $string .= $e; + } + } + + return $string; +} + +# parse a string into fields +sub _parse_seg { + my $s = shift; + my $e = { + + # raw => $s, + tag => substr( $s, 0, 3 ), + elem_arr => _get_elements( substr( $s, 3 ) ), + }; + return $e; +} + +## +# String parsing +# + +sub _get_elements { + my $seg = shift; + + $seg =~ s/^[+]//; # dont start with a dummy element` + my @elem_array = map { _components($_) } split /(?new( { seg_string => $raw }); + + passed a string representation of the segment, parses it + and retums a Segment object + +=head2 tag + + returns the three character segment tag + +=head2 elem + + $data = $s->elem($element_number, $component_number) + return the contents of a specified element and if specified + component of that element + +=head2 element + + syntactic sugar this wraps the rlem method in a fuller name + +=head2 as_string + + returns a string representation of the segment + +=head2 _parse_seg + + passed a string representation of a segment returns a hash ref with + separate tag and data elements + +=head2 _get_elements + + passed the data portion of a segment, splits it into elements, passing each to + components to further parse them. Returns a reference to an array of + elements + +=head2 _components + + Passed a string element splits it into components and returns a reference + to an array of components, if only one component is present that is returned + directly. + quote characters are removed from the components + +=head2 de_escape + + Removes Edifact escapes from the passed string and returns the modified + string + + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Edifact/Transport.pm b/Koha/Edifact/Transport.pm new file mode 100644 index 0000000..dd6f943 --- /dev/null +++ b/Koha/Edifact/Transport.pm @@ -0,0 +1,470 @@ +package Koha::Edifact::Transport; + +# Copyright 2014 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 DateTime; +use Carp; +use English qw{ -no_match_vars }; +use Net::FTP; +use Net::SFTP::Foreign; +use File::Slurp; +use File::Copy; +use File::Basename qw( fileparse ); +use File::Spec; +use Koha::Database; +use Encode qw( from_to ); + +sub new { + my ( $class, $account_id ) = @_; + my $database = Koha::Database->new(); + my $schema = $database->schema(); + my $acct = $schema->resultset('VendorEdiAccount')->find($account_id); + my $self = { + account => $acct, + schema => $schema, + working_dir => File::Spec->tmpdir(), #temporary work directory + transfer_date => DateTime->now( time_zone => 'local' ), + }; + + bless $self, $class; + return $self; +} + +sub working_directory { + my ( $self, $new_value ) = @_; + if ($new_value) { + $self->{working_directory} = $new_value; + } + return $self->{working_directory}; +} + +sub download_messages { + my ( $self, $message_type ) = @_; + $self->{message_type} = $message_type; + + my @retrieved_files; + + if ( $self->{account}->transport eq 'SFTP' ) { + @retrieved_files = $self->sftp_download(); + } + elsif ( $self->{account}->transport eq 'FILE' ) { + @retrieved_files = $self->file_download(); + } + else { # assume FTP + @retrieved_files = $self->ftp_download(); + } + return @retrieved_files; +} + +sub upload_messages { + my ( $self, @messages ) = @_; + if (@messages) { + if ( $self->{account}->transport eq 'SFTP' ) { + $self->sftp_upload(@messages); + } + elsif ( $self->{account}->transport eq 'FILE' ) { + $self->file_upload(@messages); + } + else { # assume FTP + $self->ftp_upload(@messages); + } + } + return; +} + +sub file_download { + my $self = shift; + my @downloaded_files; + + my $file_ext = _get_file_ext( $self->{message_type} ); + + my $dir = $self->{account}->download_directory; # makes code more readable + # C = ready to retrieve E = Edifact + my $msg_hash = $self->message_hash(); + if ( opendir my $dh, $dir ) { + my @file_list = readdir $dh; + closedir $dh; + foreach my $filename (@file_list) { + + if ( $filename =~ m/[.]$file_ext$/ ) { + if ( copy( "$dir/$filename", $self->{working_dir} ) ) { + } + else { + carp "copy of $filename failed"; + next; + } + push @downloaded_files, $filename; + my $processed_name = $filename; + substr $processed_name, -3, 1, 'E'; + move( "$dir/$filename", "$dir/$processed_name" ); + } + } + $self->ingest( $msg_hash, @downloaded_files ); + } + else { + carp "Cannot open $dir"; + return; + } + return @downloaded_files; +} + +sub sftp_download { + my $self = shift; + + my $file_ext = _get_file_ext( $self->{message_type} ); + + # C = ready to retrieve E = Edifact + my $msg_hash = $self->message_hash(); + my @downloaded_files; + my $sftp = Net::SFTP::Foreign->new( + $self->{account}->host, + { + user => $self->{account}->user, + password => $self->{account}->password, + timeout => 10, + } + ); + if ( $sftp->error ) { + return $self->_abort_download( undef, + 'Unable to connect to remote host: ' . $sftp->error ); + } + $sftp->setcwd( $self->{account}->download_directory ) + or return $self->_abort_download( $sftp, + "Cannot change remote dir : $sftp->error" ); + my $file_list = $sftp->ls() + or return $self->_abort_download( $sftp, + "cannot get file list from server: $sftp->error" ); + foreach my $filename ( @{$file_list} ) { + + if ( $filename =~ m/[.]$file_ext$/ ) { + $sftp->get( $filename, "$self->{working_dir}/$filename" ); + if ( $sftp->error ) { + $self->_abort_download( $sftp, + "Error retrieving $filename: $sftp->error" ); + last; + } + push @downloaded_files, $filename; + my $processed_name = $filename; + substr $processed_name, -3, 1, 'E'; + $sftp->rename( $filename, $processed_name ); + } + } + $sftp->disconnect; + $self->ingest( $msg_hash, @downloaded_files ); + + return @downloaded_files; +} + +sub ingest { + my ( $self, $msg_hash, @downloaded_files ) = @_; + foreach my $f (@downloaded_files) { + $msg_hash->{filename} = $f; + my $file_content = + read_file( "$self->{working_dir}/$f", binmode => ':raw' ); + if ( !defined $file_content ) { + carp "Unable to read download file $f"; + next; + } + from_to( $file_content, 'iso-8859-1', 'utf8' ); + $msg_hash->{raw_msg} = $file_content; + $self->{schema}->resultset('EdifactMessage')->create($msg_hash); + } + return; +} + +sub ftp_download { + my $self = shift; + + my $file_ext = _get_file_ext( $self->{message_type} ); + + # C = ready to retrieve E = Edifact + + my $msg_hash = $self->message_hash(); + my @downloaded_files; + my $ftp = Net::FTP->new( + $self->{account}->host, + Timeout => 10, + Passive => 1 + ) + or return $self->_abort_download( undef, + "Cannot connect to $self->{account}->host: $EVAL_ERROR" ); + $ftp->login( $self->{account}->username, $self->{account}->password ) + or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" ); + $ftp->cwd( $self->{account}->download_directory ) + or return $self->_abort_download( $ftp, + "Cannot change remote dir : $ftp->message()" ); + my $file_list = $ftp->ls() + or + return $self->_abort_download( $ftp, 'cannot get file list from server' ); + + foreach my $filename ( @{$file_list} ) { + + if ( $filename =~ m/[.]$file_ext$/ ) { + + if ( !$ftp->get( $filename, "$self->{working_dir}/$filename" ) ) { + $self->_abort_download( $ftp, + "Error retrieving $filename: $ftp->message" ); + last; + } + + push @downloaded_files, $filename; + my $processed_name = $filename; + substr $processed_name, -3, 1, 'E'; + $ftp->rename( $filename, $processed_name ); + } + } + $ftp->quit; + + $self->ingest( $msg_hash, @downloaded_files ); + + return @downloaded_files; +} + +sub ftp_upload { + my ( $self, @messages ) = @_; + my $ftp = Net::FTP->new( + $self->{account}->host, + Timeout => 10, + Passive => 1 + ) + or return $self->_abort_download( undef, + "Cannot connect to $self->{account}->host: $EVAL_ERROR" ); + $ftp->login( $self->{account}->username, $self->{account}->password ) + or return $self->_abort_download( $ftp, "Cannot login: $ftp->message()" ); + $ftp->cwd( $self->{account}->upload_directory ) + or return $self->_abort_download( $ftp, + "Cannot change remote dir : $ftp->message()" ); + foreach my $m (@messages) { + my $content = $m->raw_msg; + if ($content) { + open my $fh, '<', \$content; + if ( $ftp->put( $fh, $m->filename ) ) { + close $fh; + $m->transfer_date( $self->{transfer_date} ); + $m->status('sent'); + $m->update; + } + else { + # error in transfer + + } + } + } + + $ftp->quit; + return; +} + +sub sftp_upload { + my ( $self, @messages ) = @_; + my $sftp = Net::SFTP::Foreign->new( + $self->{account}->host, + { + user => $self->{account}->user, + password => $self->{account}->password, + timeout => 10, + } + ); + $sftp->die_on_error("Cannot ssh to $self->{account}->host"); + $sftp->cwd( $self->{account}->upload_directory ); + $sftp->die_on_error('Cannot change to remote dir'); + foreach my $m (@messages) { + my $content = $m->raw_msg; + if ($content) { + open my $fh, '<', \$content; + if ( $sftp->put( $fh, $m->filename ) ) { + close $fh; + $m->transfer_date( $self->{transfer_date} ); + $m->status('sent'); + $m->update; + } + else { + # error in transfer + + } + } + } + + # sftp will be closed on object destructor + return; +} + +sub file_upload { + my ( $self, @messages ) = @_; + my $dir = $self->{account}->upload_directory; + if ( -d $dir ) { + foreach my $m (@messages) { + my $content = $m->raw_msg; + if ($content) { + my $filename = $m->filename; + my $new_filename = "$dir/$filename"; + if ( open my $fh, '>', $new_filename ) { + print {$fh} $content; + close $fh; + $m->transfer_date( $self->{transfer_date} ); + $m->status('sent'); + $m->update; + } + else { + carp "Could not transfer $m->filename : $ERRNO"; + next; + } + } + } + } + else { + carp "Upload directory $dir does not exist"; + } + return; +} + +sub _abort_download { + my ( $self, $handle, $log_message ) = @_; + + my $a = $self->{account}->description; + + $handle->abort(); + $log_message .= ": $a"; + carp $log_message; + + #returns undef i.e. an empty array + return; +} + +sub _get_file_ext { + my $type = shift; + + # Extension format + # 1st char Status C = Ready For pickup A = Completed E = Extracted + # 2nd Char Standard E = Edifact + # 3rd Char Type of message + my %file_types = ( + QUOTE => 'CEQ', + INVOICE => 'CEI', + ALL => 'CE.', + ); + if ( exists $file_types{$type} ) { + return $file_types{$type}; + } + return 'XXXX'; # non matching type +} + +sub message_hash { + my $self = shift; + my $msg = { + message_type => $self->{message_type}, + vendor_id => $self->{account}->vendor_id, + edi_acct => $self->{account}->id, + status => 'new', + deleted => 0, + transfer_date => $self->{transfer_date}->ymd(), + }; + + return $msg; +} + +1; +__END__ + +=head1 NAME + Koha::Edifact::Transport + +=head1 SYNOPSIS + +my $download = Koha::Edifact::Transport->new( $vendor_edi_account_id ); +$downlod->download_messages('QUOTE'); + + +=head1 DESCRIPTION + +Module that handles Edifact download and upload transport +currently can use sftp or ftp +Or FILE to access a local directory (useful for testing) + +=head1 BUGS + + +=head1 METHODS + +=head2 new + + Creates an object of Edifact::Transport requires to be passed the id + identifying the relevant edi vendor account + +=head2 working_directory + + getter and setter for the working_directory attribute + +=head2 download_messages + + called with the message type to download will perform the download + using the appropriate transport method + +=head2 upload_messages + + passed an array of messages will upload them to the supplier site + +=head2 sftp_download + + called by download_messages to perform the download using SFTP + +=head2 ingest + + loads downloaded files into the database + +=head2 ftp_download + + called by download_messages to perform the download using FTP + +=head2 ftp_upload + + called by upload_messages to perform the upload using ftp + +=head2 sftp_upload + + called by upload_messages to perform the upload using sftp + +=head2 _abort_download + + internal routine to halt operation on error and supply a stacktrace + +=head2 _get_file_ext + + internal method returning standard suffix for file names + according to message type + +=head2 set_transport_direct + + sets the direct ingest flag so that the object reads files from + the local file system useful in debugging + +=head1 AUTHOR + + Colin Campbell + + +=head1 COPYRIGHT + + Copyright 2014, PTFS-Europe Ltd + This program is free software, You may redistribute it under + under the terms of the GNU General Public License + + +=cut diff --git a/Koha/Schema/Result/Aqbasket.pm b/Koha/Schema/Result/Aqbasket.pm index fbf1185..52cc708 100644 --- a/Koha/Schema/Result/Aqbasket.pm +++ b/Koha/Schema/Result/Aqbasket.pm @@ -263,6 +263,21 @@ __PACKAGE__->belongs_to( }, ); +=head2 edifact_messages + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_messages", + "Koha::Schema::Result::EdifactMessage", + { "foreign.basketno" => "self.basketno" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 borrowernumbers Type: many_to_many @@ -274,8 +289,8 @@ Composing rels: L -> borrowernumber __PACKAGE__->many_to_many("borrowernumbers", "aqbasketusers", "borrowernumber"); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:pT+YFf9nfD/dmBuE4RNCFw +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:tsMzwP7eofOR27sfZSTqFQ # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Aqbookseller.pm b/Koha/Schema/Result/Aqbookseller.pm index 8641a4b..36b9168 100644 --- a/Koha/Schema/Result/Aqbookseller.pm +++ b/Koha/Schema/Result/Aqbookseller.pm @@ -311,6 +311,21 @@ __PACKAGE__->has_many( { cascade_copy => 0, cascade_delete => 0 }, ); +=head2 edifact_messages + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_messages", + "Koha::Schema::Result::EdifactMessage", + { "foreign.vendor_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 invoiceprice Type: belongs_to @@ -351,9 +366,24 @@ __PACKAGE__->belongs_to( }, ); +=head2 vendor_edi_accounts + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "vendor_edi_accounts", + "Koha::Schema::Result::VendorEdiAccount", + { "foreign.vendor_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-08-26 11:53:50 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:kz1tuPJihENyV6OyCwyX/A +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:bm3bQTUitVpvT+euN9brOg # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Aqbudget.pm b/Koha/Schema/Result/Aqbudget.pm index 336e2db..d54ab17 100644 --- a/Koha/Schema/Result/Aqbudget.pm +++ b/Koha/Schema/Result/Aqbudget.pm @@ -227,6 +227,21 @@ __PACKAGE__->has_many( { cascade_copy => 0, cascade_delete => 0 }, ); +=head2 vendor_edi_accounts + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "vendor_edi_accounts", + "Koha::Schema::Result::VendorEdiAccount", + { "foreign.shipment_budget" => "self.budget_id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 borrowernumbers Type: many_to_many @@ -238,8 +253,8 @@ Composing rels: L -> borrowernumber __PACKAGE__->many_to_many("borrowernumbers", "aqbudgetborrowers", "borrowernumber"); -# Created by DBIx::Class::Schema::Loader v0.07025 @ 2013-10-14 20:56:21 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:dxOTKpdIJ6ruJUE++4fC8w +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:Ieg4SfRCek9KwaDyUKmoWA # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Aqinvoice.pm b/Koha/Schema/Result/Aqinvoice.pm index ce68093..365379e 100644 --- a/Koha/Schema/Result/Aqinvoice.pm +++ b/Koha/Schema/Result/Aqinvoice.pm @@ -70,6 +70,12 @@ __PACKAGE__->table("aqinvoices"); is_foreign_key: 1 is_nullable: 1 +=head2 message_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + =cut __PACKAGE__->add_columns( @@ -89,6 +95,8 @@ __PACKAGE__->add_columns( { data_type => "decimal", is_nullable => 1, size => [28, 6] }, "shipmentcost_budgetid", { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "message_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, ); =head1 PRIMARY KEY @@ -135,6 +143,26 @@ __PACKAGE__->belongs_to( { is_deferrable => 1, on_delete => "CASCADE", on_update => "CASCADE" }, ); +=head2 message + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "message", + "Koha::Schema::Result::EdifactMessage", + { id => "message_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "SET NULL", + on_update => "RESTRICT", + }, +); + =head2 shipmentcost_budgetid Type: belongs_to @@ -156,8 +184,8 @@ __PACKAGE__->belongs_to( ); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-07-11 09:26:55 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:3se4f767VfvBKaZ8tlXwHQ +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FPZXlNt8dkjhgt2Rtc+krQ # You can replace this text with custom content, and it will be preserved on regeneration diff --git a/Koha/Schema/Result/Branch.pm b/Koha/Schema/Result/Branch.pm index 106123a..9d84ab9 100644 --- a/Koha/Schema/Result/Branch.pm +++ b/Koha/Schema/Result/Branch.pm @@ -397,6 +397,21 @@ __PACKAGE__->might_have( { cascade_copy => 0, cascade_delete => 0 }, ); +=head2 edifact_eans + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_eans", + "Koha::Schema::Result::EdifactEan", + { "foreign.branchcode" => "self.branchcode" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + =head2 hold_fill_targets Type: has_many @@ -513,9 +528,9 @@ Composing rels: L -> categorycode __PACKAGE__->many_to_many("categorycodes", "branchrelations", "categorycode"); -# Created by DBIx::Class::Schema::Loader v0.07039 @ 2014-11-06 15:26:36 -# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:CGNPB/MkGLOihDThj43/4A +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-11-26 11:08:29 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:FjNI9OEpa5OKfwwCkggu0w -# You can replace this text with custom content, and it will be preserved on regeneration +# You can replace this text with custom code or comments, and it will be preserved on regeneration 1; diff --git a/Koha/Schema/Result/EdifactEan.pm b/Koha/Schema/Result/EdifactEan.pm new file mode 100644 index 0000000..56eb7b7 --- /dev/null +++ b/Koha/Schema/Result/EdifactEan.pm @@ -0,0 +1,91 @@ +use utf8; +package Koha::Schema::Result::EdifactEan; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::EdifactEan + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("edifact_ean"); + +=head1 ACCESSORS + +=head2 branchcode + + data_type: 'varchar' + is_foreign_key: 1 + is_nullable: 0 + size: 10 + +=head2 ean + + data_type: 'varchar' + is_nullable: 0 + size: 15 + +=head2 id_code_qualifier + + data_type: 'varchar' + default_value: 14 + is_nullable: 0 + size: 3 + +=cut + +__PACKAGE__->add_columns( + "branchcode", + { data_type => "varchar", is_foreign_key => 1, is_nullable => 0, size => 10 }, + "ean", + { data_type => "varchar", is_nullable => 0, size => 15 }, + "id_code_qualifier", + { data_type => "varchar", default_value => 14, is_nullable => 0, size => 3 }, +); + +=head1 RELATIONS + +=head2 branchcode + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "branchcode", + "Koha::Schema::Result::Branch", + { branchcode => "branchcode" }, + { is_deferrable => 1, on_delete => "RESTRICT", on_update => "RESTRICT" }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:s5Z9txnCIqGyvOj02EOtdQ + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration +__PACKAGE__->belongs_to('branch', + "Koha::Schema::Result::Branch", + { 'branchcode' => 'branchcode' }, + { + is_deferrable => 1, + join_type => 'LEFT', + on_delete => 'CASCADE', + on_update => 'CASCADE', + }, +); + +1; diff --git a/Koha/Schema/Result/EdifactMessage.pm b/Koha/Schema/Result/EdifactMessage.pm new file mode 100644 index 0000000..7befb73 --- /dev/null +++ b/Koha/Schema/Result/EdifactMessage.pm @@ -0,0 +1,202 @@ +use utf8; +package Koha::Schema::Result::EdifactMessage; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::EdifactMessage + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("edifact_messages"); + +=head1 ACCESSORS + +=head2 id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 message_type + + data_type: 'varchar' + is_nullable: 0 + size: 10 + +=head2 transfer_date + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 vendor_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 edi_acct + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 status + + data_type: 'text' + is_nullable: 1 + +=head2 basketno + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 raw_msg + + data_type: 'text' + is_nullable: 1 + +=head2 filename + + data_type: 'text' + is_nullable: 1 + +=head2 deleted + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=cut + +__PACKAGE__->add_columns( + "id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "message_type", + { data_type => "varchar", is_nullable => 0, size => 10 }, + "transfer_date", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 }, + "vendor_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "edi_acct", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "status", + { data_type => "text", is_nullable => 1 }, + "basketno", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "raw_msg", + { data_type => "text", is_nullable => 1 }, + "filename", + { data_type => "text", is_nullable => 1 }, + "deleted", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("id"); + +=head1 RELATIONS + +=head2 aqinvoices + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "aqinvoices", + "Koha::Schema::Result::Aqinvoice", + { "foreign.message_id" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + +=head2 basketno + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "basketno", + "Koha::Schema::Result::Aqbasket", + { basketno => "basketno" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 edi_acct + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "edi_acct", + "Koha::Schema::Result::VendorEdiAccount", + { id => "edi_acct" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 vendor + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "vendor", + "Koha::Schema::Result::Aqbookseller", + { id => "vendor_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-18 16:21:46 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:aOMWguyzdK9caRRecsuTmQ + + +1; diff --git a/Koha/Schema/Result/MsgInvoice.pm b/Koha/Schema/Result/MsgInvoice.pm new file mode 100644 index 0000000..830d6e5 --- /dev/null +++ b/Koha/Schema/Result/MsgInvoice.pm @@ -0,0 +1,115 @@ +use utf8; +package Koha::Schema::Result::MsgInvoice; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::MsgInvoice + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("msg_invoice"); + +=head1 ACCESSORS + +=head2 mi_id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 msg_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 invoiceid + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=cut + +__PACKAGE__->add_columns( + "mi_id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "msg_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "invoiceid", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("mi_id"); + +=head1 RELATIONS + +=head2 invoiceid + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "invoiceid", + "Koha::Schema::Result::Aqinvoice", + { invoiceid => "invoiceid" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 msg + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "msg", + "Koha::Schema::Result::EdifactMessage", + { id => "msg_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-09-02 11:37:47 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:F1jqlEH57dpxn2Pvm/vPGA + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration +1; diff --git a/Koha/Schema/Result/VendorEdiAccount.pm b/Koha/Schema/Result/VendorEdiAccount.pm new file mode 100644 index 0000000..8d7aac3 --- /dev/null +++ b/Koha/Schema/Result/VendorEdiAccount.pm @@ -0,0 +1,233 @@ +use utf8; +package Koha::Schema::Result::VendorEdiAccount; + +# Created by DBIx::Class::Schema::Loader +# DO NOT MODIFY THE FIRST PART OF THIS FILE + +=head1 NAME + +Koha::Schema::Result::VendorEdiAccount + +=cut + +use strict; +use warnings; + +use base 'DBIx::Class::Core'; + +=head1 TABLE: C + +=cut + +__PACKAGE__->table("vendor_edi_accounts"); + +=head1 ACCESSORS + +=head2 id + + data_type: 'integer' + is_auto_increment: 1 + is_nullable: 0 + +=head2 description + + data_type: 'text' + is_nullable: 0 + +=head2 host + + data_type: 'varchar' + is_nullable: 1 + size: 40 + +=head2 username + + data_type: 'varchar' + is_nullable: 1 + size: 40 + +=head2 password + + data_type: 'varchar' + is_nullable: 1 + size: 40 + +=head2 last_activity + + data_type: 'date' + datetime_undef_if_invalid: 1 + is_nullable: 1 + +=head2 vendor_id + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=head2 download_directory + + data_type: 'text' + is_nullable: 1 + +=head2 upload_directory + + data_type: 'text' + is_nullable: 1 + +=head2 san + + data_type: 'varchar' + is_nullable: 1 + size: 20 + +=head2 id_code_qualifier + + data_type: 'varchar' + default_value: 14 + is_nullable: 1 + size: 3 + +=head2 transport + + data_type: 'varchar' + default_value: 'FTP' + is_nullable: 1 + size: 6 + +=head2 quotes_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 invoices_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 orders_enabled + + data_type: 'tinyint' + default_value: 0 + is_nullable: 0 + +=head2 shipment_budget + + data_type: 'integer' + is_foreign_key: 1 + is_nullable: 1 + +=cut + +__PACKAGE__->add_columns( + "id", + { data_type => "integer", is_auto_increment => 1, is_nullable => 0 }, + "description", + { data_type => "text", is_nullable => 0 }, + "host", + { data_type => "varchar", is_nullable => 1, size => 40 }, + "username", + { data_type => "varchar", is_nullable => 1, size => 40 }, + "password", + { data_type => "varchar", is_nullable => 1, size => 40 }, + "last_activity", + { data_type => "date", datetime_undef_if_invalid => 1, is_nullable => 1 }, + "vendor_id", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, + "download_directory", + { data_type => "text", is_nullable => 1 }, + "upload_directory", + { data_type => "text", is_nullable => 1 }, + "san", + { data_type => "varchar", is_nullable => 1, size => 20 }, + "id_code_qualifier", + { data_type => "varchar", default_value => 14, is_nullable => 1, size => 3 }, + "transport", + { data_type => "varchar", default_value => "FTP", is_nullable => 1, size => 6 }, + "quotes_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "invoices_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "orders_enabled", + { data_type => "tinyint", default_value => 0, is_nullable => 0 }, + "shipment_budget", + { data_type => "integer", is_foreign_key => 1, is_nullable => 1 }, +); + +=head1 PRIMARY KEY + +=over 4 + +=item * L + +=back + +=cut + +__PACKAGE__->set_primary_key("id"); + +=head1 RELATIONS + +=head2 edifact_messages + +Type: has_many + +Related object: L + +=cut + +__PACKAGE__->has_many( + "edifact_messages", + "Koha::Schema::Result::EdifactMessage", + { "foreign.edi_acct" => "self.id" }, + { cascade_copy => 0, cascade_delete => 0 }, +); + +=head2 shipment_budget + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "shipment_budget", + "Koha::Schema::Result::Aqbudget", + { budget_id => "shipment_budget" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + +=head2 vendor + +Type: belongs_to + +Related object: L + +=cut + +__PACKAGE__->belongs_to( + "vendor", + "Koha::Schema::Result::Aqbookseller", + { id => "vendor_id" }, + { + is_deferrable => 1, + join_type => "LEFT", + on_delete => "RESTRICT", + on_update => "RESTRICT", + }, +); + + +# Created by DBIx::Class::Schema::Loader v0.07033 @ 2014-10-02 17:14:15 +# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:6Yp5lyH2ld4lrmaM0OeYcw + + +# You can replace this text with custom code or comments, and it will be preserved on regeneration +1; diff --git a/acqui/basket.pl b/acqui/basket.pl index e04024a..4ad1247 100755 --- a/acqui/basket.pl +++ b/acqui/basket.pl @@ -36,6 +36,8 @@ use C4::Members qw/GetMember/; #needed for permissions checking for changing ba use C4::Items; use C4::Suggestions; use Date::Calc qw/Add_Delta_Days/; +use Koha::Database; +use Koha::EDI qw( create_edi_order get_edifact_ean ); =head1 NAME @@ -67,6 +69,7 @@ the supplier this script have to display the basket. my $query = new CGI; our $basketno = $query->param('basketno'); +my $ean = $query->param('ean'); my $booksellerid = $query->param('booksellerid'); my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( @@ -83,6 +86,10 @@ my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( my $basket = GetBasket($basketno); $booksellerid = $basket->{booksellerid} unless $booksellerid; my $bookseller = Koha::Acquisition::Bookseller->fetch({ id => $booksellerid }); +my $schema = Koha::Database->new()->schema(); +my $rs = $schema->resultset('VendorEdiAccount')->search( + { vendor_id => $booksellerid, } ); +$template->param( ediaccount => ($rs->count > 0)); unless (CanUserManageBasket($loggedinuser, $basket, $userflags)) { $template->param( @@ -236,6 +243,9 @@ if ( $op eq 'delete_confirm' ) { } elsif ($op eq 'reopen') { ReopenBasket($query->param('basketno')); print $query->redirect('/cgi-bin/koha/acqui/basket.pl?basketno='.$basket->{'basketno'}) +} +elsif ( $op eq 'ediorder' ) { + edi_close_and_order() } elsif ( $op eq 'mod_users' ) { my $basketusers_ids = $query->param('basketusers_ids'); my @basketusers = split( /:/, $basketusers_ids ); @@ -447,6 +457,7 @@ sub get_order_infos { $line{basketno} = $basketno; $line{budget_name} = $budget->{budget_name}; $line{rrp} = ConvertCurrency( $order->{'currency'}, $line{rrp} ); # FIXME from comm + $line{gstrate} ||= 0; if ( $bookseller->{'listincgst'} ) { $line{rrpgsti} = sprintf( "%.2f", $line{rrp} ); $line{gstgsti} = sprintf( "%.2f", $line{gstrate} * 100 ); @@ -532,3 +543,70 @@ sub get_order_infos { } output_html_with_http_headers $query, $cookie, $template->output; + + +sub edi_close_and_order { + my $confirm = $query->param('confirm') || $confirm_pref eq '2'; + if ($confirm) { + my $edi_params = { + basketno => $basketno, + ean => $ean, + }; + if ( $basket->{branch} ) { + $edi_params->{branchcode} = $basket->{branch}; + } + if ( create_edi_order($edi_params) ) { + #$template->param( edifile => 1 ); + } + CloseBasket($basketno); + + # if requested, create basket group, close it and attach the basket + if ( $query->param('createbasketgroup') ) { + my $branchcode; + if ( C4::Context->userenv + and C4::Context->userenv->{'branch'} + and C4::Context->userenv->{'branch'} ne "NO_LIBRARY_SET" ) + { + $branchcode = C4::Context->userenv->{'branch'}; + } + my $basketgroupid = NewBasketgroup( + { + name => $basket->{basketname}, + booksellerid => $booksellerid, + deliveryplace => $branchcode, + billingplace => $branchcode, + closed => 1, + } + ); + ModBasket( + { + basketno => $basketno, + basketgroupid => $basketgroupid + } + ); + print $query->redirect( +"/cgi-bin/koha/acqui/basketgroup.pl?booksellerid=$booksellerid&closed=1" + ); + } + else { + print $query->redirect( + "/cgi-bin/koha/acqui/booksellers.pl?booksellerid=$booksellerid" + ); + } + exit; + } + else { + $template->param( + edi_confirm => 1, + booksellerid => $booksellerid, + basketno => $basket->{basketno}, + basketname => $basket->{basketname}, + basketgroupname => $basket->{basketname}, + ); + if ($ean) { + $template->param( ean => $ean ); + } + + } + return; +} diff --git a/acqui/basketgroup.pl b/acqui/basketgroup.pl index ef62921..67f54ee 100755 --- a/acqui/basketgroup.pl +++ b/acqui/basketgroup.pl @@ -56,6 +56,7 @@ use C4::Budgets qw/ConvertCurrency/; use C4::Acquisition qw/CloseBasketgroup ReOpenBasketgroup GetOrders GetBasketsByBasketgroup GetBasketsByBookseller ModBasketgroup NewBasketgroup DelBasketgroup GetBasketgroups ModBasket GetBasketgroup GetBasket GetBasketGroupAsCSV/; use C4::Branch qw/GetBranches/; use C4::Members qw/GetMember/; +use Koha::EDI qw/create_edi_order get_edifact_ean/; use Koha::Acquisition::Bookseller; @@ -235,12 +236,24 @@ sub printbasketgrouppdf{ } +sub generate_edifact_orders { + my $basketgroupid = shift; + my $baskets = GetBasketsByBasketgroup($basketgroupid); + my $ean = get_edifact_ean(); + + for my $basket ( @{$baskets} ) { + create_edi_order( { ean => $ean, basketno => $basket->{basketno}, } ); + } + return; +} + my $op = $input->param('op') || 'display'; # possible values of $op : # - add : adds a new basketgroup, or edit an open basketgroup, or display a closed basketgroup # - mod_basket : modify an individual basket of the basketgroup # - closeandprint : close and print an closed basketgroup in pdf. called by clicking on "Close and print" button in closed basketgroups list # - print : print a closed basketgroup. called by clicking on "Print" button in closed basketgroups list +# - ediprint : generate edi order messages for the baskets in the group # - export : export in CSV a closed basketgroup. called by clicking on "Export" button in closed basketgroups list # - delete : delete an open basketgroup. called by clicking on "Delete" button in open basketgroups list # - reopen : reopen a closed basketgroup. called by clicking on "Reopen" button in closed basketgroup list @@ -399,6 +412,10 @@ if ( $op eq "add" ) { $redirectpath .= "&listclosed=1" if $closedbg ; print $input->redirect($redirectpath ); +} elsif ( $op eq 'ediprint') { + my $basketgroupid = $input->param('basketgroupid'); + generate_edifact_orders( $basketgroupid ); + exit; }else{ # no param : display the list of all basketgroups for a given vendor my $basketgroups = &GetBasketgroups($booksellerid); diff --git a/acqui/edi_ean.pl b/acqui/edi_ean.pl new file mode 100755 index 0000000..8d447b2 --- /dev/null +++ b/acqui/edi_ean.pl @@ -0,0 +1,64 @@ +#!/usr/bin/perl + +# Copyright 2012 Mark Gavillet & 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +# This is an awkward construct and should probably be totally replaced +# but as all sites so far are single ordering ean its not clear what we should +# replace it with +# +use strict; +use warnings; + +use C4::Auth; +use C4::Koha; +use C4::Output; +use Koha::Database; +use CGI; +my $schema = Koha::Database->new()->schema(); + +my @eans = $schema->resultset('EdifactEan')->search( + {}, + { + join => 'branch', + } +); +my $query = CGI->new(); +my $basketno = $query->param('basketno'); + +if ( @eans == 1 ) { + my $ean = $eans[0]->ean; + print $query->redirect( + "/cgi-bin/koha/acqui/basket.pl?basketno=$basketno&op=ediorder&ean=$ean" + ); +} +else { + my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => 'acqui/edi_ean.tt', + query => $query, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'order_manage' }, + debug => 1, + } + ); + $template->param( eans => \@eans ); + $template->param( basketno => $basketno ); + + output_html_with_http_headers( $query, $cookie, $template->output ); +} diff --git a/acqui/edifactmsgs.pl b/acqui/edifactmsgs.pl new file mode 100755 index 0000000..664bd77 --- /dev/null +++ b/acqui/edifactmsgs.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl + +# Copyright 2014 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; + +use CGI; +use Koha::Database; +use C4::Koha; +use C4::Auth; +use C4::Output; + +my $q = CGI->new; +my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( + { + template_name => 'acqui/edifactmsgs.tt', + query => $q, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'manage_edi' }, + debug => 1, + } +); + +my $schema = Koha::Database->new()->schema(); + +my @msgs = $schema->resultset('EdifactMessage')->search( + { + deleted => 0, + }, + { + join => 'vendor', + order_by => { -desc => 'transfer_date' }, + } + +)->all; + +$template->param( messages => \@msgs ); + +output_html_with_http_headers( $q, $cookie, $template->output ); diff --git a/acqui/edimsg.pl b/acqui/edimsg.pl new file mode 100755 index 0000000..4572e23 --- /dev/null +++ b/acqui/edimsg.pl @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +# Copyright 2014 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; + +use CGI; +use Koha::Database; +use C4::Koha; +use C4::Auth; +use C4::Output; + +my $q = CGI->new; +my ( $template, $loggedinuser, $cookie, $userflags ) = get_template_and_user( + { + template_name => 'acqui/edimsg.tt', + query => $q, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'manage_edi' }, + debug => 1, + } +); +my $msg_id = $q->param('id'); +my $schema = Koha::Database->new()->schema(); + +my $msg = $schema->resultset('EdifactMessage')->find($msg_id); +if ($msg) { + my $transmission = $msg->raw_msg; + + my @segments = segmentize($transmission); + $template->param( segments => \@segments ); +} +else { + $template->param( no_message => 1 ); +} + +output_html_with_http_headers( $q, $cookie, $template->output ); + +sub segmentize { + my $raw = shift; + + my $re = qr{ +(?> # dont backtrack into this group + [?]. # either the escape character + # followed by any other character + | # or + [^'?] # a character that is neither escape + # nor split + )+ +}x; + my @segmented; + while ( $raw =~ /($re)/g ) { + push @segmented, "$1'"; + } + return @segmented; +} diff --git a/acqui/invoices.pl b/acqui/invoices.pl index 4c72d64..b84b4df 100755 --- a/acqui/invoices.pl +++ b/acqui/invoices.pl @@ -61,6 +61,7 @@ my $author = $input->param('author'); my $publisher = $input->param('publisher'); my $publicationyear = $input->param('publicationyear'); my $branch = $input->param('branch'); +my $message_id = $input->param('message_id'); my $op = $input->param('op'); my $invoices = []; @@ -81,7 +82,8 @@ if ( $op and $op eq 'do_search' ) { author => $author, publisher => $publisher, publicationyear => $publicationyear, - branchcode => $branch + branchcode => $branch, + message_id => $message_id, ); } diff --git a/admin/edi_accounts.pl b/admin/edi_accounts.pl new file mode 100755 index 0000000..945cd3f --- /dev/null +++ b/admin/edi_accounts.pl @@ -0,0 +1,153 @@ +#!/usr/bin/perl + +# Copyright 2011,2014 Mark Gavillet & 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use CGI; +use C4::Auth; +use C4::Output; +use Koha::Database; + +my $input = CGI->new(); + +my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => 'admin/edi_accounts.tt', + query => $input, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'edi_manage' }, + } +); + +my $op = $input->param('op'); +$op ||= 'display'; +my $schema = Koha::Database->new()->schema(); + +if ( $op eq 'acct_form' ) { + show_account(); + $template->param( acct_form => 1 ); + my @vendors = $schema->resultset('Aqbookseller')->search( + undef, + { + columns => [ 'name', 'id' ], + order_by => { -asc => 'name' } + } + ); + $template->param( vendors => \@vendors ); + $template->param( + code_qualifiers => [ + { + code => '14', + description => 'EAN International', + }, + { + code => '31B', + description => 'US SAN Agency', + }, + { + code => '91', + description => 'Assigned by supplier', + }, + { + code => '92', + description => 'Assigned by buyer', + }, + ] + ); + +} +elsif ( $op eq 'delete_confirm' ) { + show_account(); + $template->param( delete_confirm => 1 ); +} +else { + if ( $op eq 'save' ) { + + # validate & display + my $id = $input->param('id'); + my $fields = { + description => $input->param('description'), + host => $input->param('host'), + username => $input->param('username'), + password => $input->param('password'), + vendor_id => $input->param('vendor_id'), + upload_directory => $input->param('upload_directory'), + download_directory => $input->param('download_directory'), + san => $input->param('san'), + transport => $input->param('transport'), + quotes_enabled => defined $input->param('quotes_enabled'), + invoices_enabled => defined $input->param('invoices_enabled'), + orders_enabled => defined $input->param('orders_enabled'), + id_code_qualifier => $input->param('id_code_qualifier'), + }; + + if ($id) { + $schema->resultset('VendorEdiAccount')->search( + { + id => $id, + } + )->update_all($fields); + } + else { # new record + $schema->resultset('VendorEdiAccount')->create($fields); + } + } + elsif ( $op eq 'delete_confirmed' ) { + + $schema->resultset('VendorEdiAccount') + ->search( { id => $input->param('id'), } )->delete_all; + } + + # we do a default dispaly after deletes and saves + # as well as when thats all you want + $template->param( display => 1 ); + my @ediaccounts = $schema->resultset('VendorEdiAccount')->search( + {}, + { + join => 'vendor', + } + ); + $template->param( ediaccounts => \@ediaccounts ); +} + +output_html_with_http_headers( $input, $cookie, $template->output ); + +sub get_account { + my $id = shift; + + my $account = $schema->resultset('VendorEdiAccount')->find($id); + if ($account) { + return $account; + } + + # passing undef will default to add + return; +} + +sub show_account { + my $acct_id = $input->param('id'); + if ($acct_id) { + my $acct = $schema->resultset('VendorEdiAccount')->find($acct_id); + if ($acct) { + $template->param( account => $acct ); + } + } + return; +} diff --git a/admin/edi_ean_accounts.pl b/admin/edi_ean_accounts.pl new file mode 100755 index 0000000..6c5c2c2 --- /dev/null +++ b/admin/edi_ean_accounts.pl @@ -0,0 +1,158 @@ +#!/usr/bin/perl + +# Copyright 2012, 2014 Mark Gavillet & 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use CGI; +use C4::Auth; +use C4::Output; +use Koha::Database; + +my $input = CGI->new(); + +my ( $template, $loggedinuser, $cookie ) = get_template_and_user( + { + template_name => 'admin/edi_ean_accounts.tt', + query => $input, + type => 'intranet', + authnotrequired => 0, + flagsrequired => { acquisition => 'edi_manage' }, + } +); + +my $schema = Koha::Database->new()->schema(); +my $op = $input->param('op'); +$op ||= 'display'; + +if ( $op eq 'ean_form' ) { + show_ean(); + $template->param( ean_form => 1 ); + my @branches = $schema->resultset('Branch')->search( + undef, + { + columns => [ 'branchcode', 'branchname' ], + order_by => 'branchname', + } + ); + $template->param( branches => \@branches ); + $template->param( + code_qualifiers => [ + { + code => '14', + description => 'EAN International', + }, + { + code => '31B', + description => 'US SAN Agency', + }, + { + code => '91', + description => 'Assigned by supplier', + }, + { + code => '92', + description => 'Assigned by buyer', + }, + ] + ); + +} +elsif ( $op eq 'delete_confirm' ) { + show_ean(); + $template->param( delete_confirm => 1 ); +} +else { + if ( $op eq 'save' ) { + my $change = $input->param('oldean'); + if ($change) { + editsubmit(); + } + else { + addsubmit(); + } + } + elsif ( $op eq 'delete_confirmed' ) { + delsubmit(); + } + my @eans = $schema->resultset('EdifactEan')->search( + {}, + { + join => 'branch', + } + ); + $template->param( display => 1 ); + $template->param( eans => \@eans ); +} + +output_html_with_http_headers( $input, $cookie, $template->output ); + +sub delsubmit { + my $ean = $schema->resultset('EdifactEan')->find( + { + branchcode => $input->param('branchcode'), + ean => $input->param('ean') + } + ); + $ean->delete; + return; +} + +sub addsubmit { + + my $new_ean = $schema->resultset('EdifactEan')->new( + { + branchcode => $input->param('branchcode'), + ean => $input->param('ean'), + id_code_qualifier => $input->param('id_code_qualifier'), + } + ); + $new_ean->insert(); + return; +} + +sub editsubmit { + $schema->resultset('EdifactEan')->search( + { + branchcode => $input->param('oldbranchcode'), + ean => $input->param('oldean'), + } + )->update_all( + { + branchcode => $input->param('branchcode'), + ean => $input->param('ean'), + id_code_qualifier => $input->param('id_code_qualifier'), + } + ); + return; +} + +sub show_ean { + my $branchcode = $input->param('branchcode'); + my $ean = $input->param('ean'); + if ( $branchcode && $ean ) { + my $e = $schema->resultset('EdifactEan')->find( + { + ean => $ean, + branchcode => $branchcode, + } + ); + $template->param( ean => $e ); + } + return; +} diff --git a/installer/data/mysql/en/mandatory/userpermissions.sql b/installer/data/mysql/en/mandatory/userpermissions.sql index 65c4bb8..9d0cc9d 100644 --- a/installer/data/mysql/en/mandatory/userpermissions.sql +++ b/installer/data/mysql/en/mandatory/userpermissions.sql @@ -27,6 +27,7 @@ INSERT INTO permissions (module_bit, code, description) VALUES (11, 'order_receive', 'Manage orders & basket'), (11, 'budget_add_del', 'Add and delete budgets (but can''t modify budgets)'), (11, 'budget_manage_all', 'Manage all budgets'), + (11, 'edi_manage', 'Manage EDIFACT transmissions'), (13, 'edit_news', 'Write news for the OPAC and staff interfaces'), (13, 'label_creator', 'Create printable labels and barcodes from catalog and patron data'), (13, 'edit_calendar', 'Define days when the library is closed'), diff --git a/installer/data/mysql/kohastructure.sql b/installer/data/mysql/kohastructure.sql index 1f22106..a0b7f3a 100644 --- a/installer/data/mysql/kohastructure.sql +++ b/installer/data/mysql/kohastructure.sql @@ -3118,6 +3118,60 @@ CREATE TABLE aqorders_transfers ( ) ENGINE=InnoDB DEFAULT CHARSET=utf8; -- +-- Table structure for table vendor_edi_accounts +-- + +DROP TABLE IF EXISTS vendor_edi_accounts; +CREATE TABLE IF NOT EXISTS vendor_edi_accounts ( + id int(11) NOT NULL auto_increment, + description text NOT NULL, + host varchar(40), + username varchar(40), + password varchar(40), + last_activity date, + vendor_id int(11) references aqbooksellers( id ), + download_directory text, + upload_directory text, + san varchar(20), + id_code_qualifier varchar(3) default '14', + transport varchar(6) default 'FTP', + quotes_enabled tinyint(1) not null default 0, + invoices_enabled tinyint(1) not null default 0, + orders_enabled tinyint(1) not null default 0, + shipment_budget integer(11) references aqbudgets( budget_id ), + PRIMARY KEY (id), + KEY vendorid (vendor_id), + KEY shipmentbudget (shipment_budget), + CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + +-- +-- Table structure for table edifact_messages +-- + +DROP TABLE IF EXISTS edifact_messages; +CREATE TABLE IF NOT EXISTS edifact_messages ( + id int(11) NOT NULL auto_increment, + message_type varchar(10) NOT NULL, + transfer_date date, + vendor_id int(11) references aqbooksellers( id ), + edi_acct integer references vendor_edi_accounts( id ), + status text, + basketno int(11) references aqbasket( basketno), + raw_msg text, + filename text, + deleted boolean not null default 0, + PRIMARY KEY (id), + KEY vendorid ( vendor_id), + KEY ediacct (edi_acct), + KEY basketno ( basketno), + CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ), + CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + +-- -- Table structure for table aqinvoices -- @@ -3131,9 +3185,11 @@ CREATE TABLE aqinvoices ( closedate date default NULL, -- invoice close date, NULL means the invoice is open shipmentcost decimal(28,6) default NULL, -- shipment cost shipmentcost_budgetid int(11) default NULL, -- foreign key to aqbudgets, link the shipment cost to a budget + message_id int(11) default NULL, -- foreign key to edifact invoice message PRIMARY KEY (invoiceid), CONSTRAINT aqinvoices_fk_aqbooksellerid FOREIGN KEY (booksellerid) REFERENCES aqbooksellers (id) ON DELETE CASCADE ON UPDATE CASCADE, - CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE + CONSTRAINT aqinvoices_fk_shipmentcost_budgetid FOREIGN KEY (shipmentcost_budgetid) REFERENCES aqbudgets (budget_id) ON DELETE SET NULL ON UPDATE CASCADE, + CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL ) ENGINE=InnoDB DEFAULT CHARSET=utf8; @@ -3502,6 +3558,18 @@ CREATE TABLE items_search_fields ( ON DELETE SET NULL ON UPDATE CASCADE ) ENGINE=InnoDB DEFAULT CHARSET=utf8; +-- +-- Table structure for table 'edifact_ean' +-- + +DROP TABLE IF EXISTS edifact_ean; +CREATE TABLE IF NOT EXISTS edifact_ean ( + branchcode varchar(10) not null references branches (branchcode), + ean varchar(15) NOT NULL, + id_code_qualifier varchar(3) NOT NULL default '14', + CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8; + /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; diff --git a/installer/data/mysql/sysprefs.sql b/installer/data/mysql/sysprefs.sql index 89707ef..a83f6f6 100644 --- a/installer/data/mysql/sysprefs.sql +++ b/installer/data/mysql/sysprefs.sql @@ -473,4 +473,5 @@ INSERT INTO systempreferences ( `variable`, `value`, `options`, `explanation`, ` ('XSLTResultsDisplay','default','','Enable XSL stylesheet control over results page display on intranet','Free'), ('z3950AuthorAuthFields','701,702,700',NULL,'Define the MARC biblio fields for Personal Name Authorities to fill biblio.author','free'), ('z3950NormalizeAuthor','0','','If ON, Personal Name Authorities will replace authors in biblio.author','YesNo') +('EDIInvoicesShippingBudget',NULL,NULL,'The budget code used to allocate shipping charges to when processing EDI Invoice messages','free') ; diff --git a/installer/data/mysql/updatedatabase.pl b/installer/data/mysql/updatedatabase.pl index d2b03c3..d76559f 100755 --- a/installer/data/mysql/updatedatabase.pl +++ b/installer/data/mysql/updatedatabase.pl @@ -9656,6 +9656,86 @@ if(CheckVersion($DBversion)) { SetVersion($DBversion); } +$DBversion = "3.17.00.XXX"; +if( CheckVersion($DBversion) ){ + + my $sql=<<'VEA_END'; +CREATE TABLE IF NOT EXISTS vendor_edi_accounts ( + id int(11) NOT NULL auto_increment, + description text NOT NULL, + host varchar(40), + username varchar(40), + password varchar(40), + last_activity date, + vendor_id int(11) references aqbooksellers( id ), + download_directory text, + upload_directory text, + san varchar(20), + id_code_qualifier varchar(3) default '14', + transport varchar(6) default 'FTP', + quotes_enabled tinyint(1) not null default 0, + invoices_enabled tinyint(1) not null default 0, + orders_enabled tinyint(1) not null default 0, + shipment_budget integer(11) references aqbudgets( budget_id ), + PRIMARY KEY (id), + KEY vendorid (vendor_id), + KEY shipmentbudget (shipment_budget), + CONSTRAINT vfk_vendor_id FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT vfk_shipment_budget FOREIGN KEY ( shipment_budget ) REFERENCES aqbudgets ( budget_id ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8 +VEA_END + + $dbh->do($sql); + + $sql=<<'EM_END'; +CREATE TABLE IF NOT EXISTS edifact_messages ( + id int(11) NOT NULL auto_increment, + message_type varchar(10) NOT NULL, + transfer_date date, + vendor_id int(11) references aqbooksellers( id ), + edi_acct integer references vendor_edi_accounts( id ), + status text, + basketno int(11) REFERENCES aqbasket( basketno), + raw_msg text, + filename text, + deleted boolean not null default 0, + PRIMARY KEY (id), + KEY vendorid ( vendor_id), + KEY ediacct (edi_acct), + KEY basketno ( basketno), + CONSTRAINT emfk_vendor FOREIGN KEY ( vendor_id ) REFERENCES aqbooksellers ( id ), + CONSTRAINT emfk_edi_acct FOREIGN KEY ( edi_acct ) REFERENCES vendor_edi_accounts ( id ), + CONSTRAINT emfk_basketno FOREIGN KEY ( basketno ) REFERENCES aqbasket ( basketno ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8 +EM_END + + $dbh->do($sql); + + $dbh->do('ALTER TABLE aqinvoices ADD COLUMN message_id INT(11) REFERENCES edifact_messages( id )'); + + $dbh->do( + 'ALTER TABLE aqinvoices ADD CONSTRAINT edifact_msg_fk FOREIGN KEY ( message_id ) REFERENCES edifact_messages ( id ) ON DELETE SET NULL' + ); + + $sql=<<'EAN_END'; +CREATE TABLE IF NOT EXISTS edifact_ean ( + branchcode VARCHAR(10) NOT NULL REFERENCES branches (branchcode), + ean varchar(15) NOT NULL, + id_code_qualifier VARCHAR(3) NOT NULL DEFAULT '14', + CONSTRAINT efk_branchcode FOREIGN KEY ( branchcode ) REFERENCES branches ( branchcode ) +) ENGINE=InnoDB DEFAULT CHARSET=utf8 +EAN_END + + $dbh->do($sql); + $dbh->do("INSERT INTO systempreferences (variable, explanation, type) VALUES('EDIInvoicesShippingBudget','The budget code used to allocate shipping charges to when processing EDI Invoice messages', 'free')"); + $dbh->do( + q{INSERT INTO permissions (module_bit, code, description) values (11, 'edi_manage', 'Manage EDIFACT transmissions')} + ); + + print "Upgrade to $DBversion done (Bug 7736 DB Changes for Edifact Processing ( Quote, Order and Invoice))\n"; + SetVersion($DBversion); +} + =head1 FUNCTIONS =head2 TableExists($table) diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc index 439118d..c33d6d4 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/acquisitions-menu.inc @@ -9,4 +9,7 @@ [% IF ( CAN_user_parameters ) %]
  • Currencies
    • [% END %] + [% IF CAN_user_acquisition_edi_manage %] +
  • Edifact Messages
    • + [% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc b/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc index 281bb54..a866a6a 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc +++ b/koha-tmpl/intranet-tmpl/prog/en/includes/admin-menu.inc @@ -54,6 +54,8 @@
  • Currencies and exchange rates
  • Budgets
  • Funds
    • +
  • EDI accounts
    • +
  • EDI eans
    • diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt index 9cc23bd..053f2a0 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basket.tt @@ -54,6 +54,13 @@ window.open(url, 'TransferOrder','width=600,height=400,toolbar=false,scrollbars=yes'); } + function confirm_ediorder() { + var is_confirmed = confirm(_("Are you sure you want to close this basket and generate an Edifact order?")); + if (is_confirmed) { + window.location = "[% script_name %]?op=edi_confirm&basketno=[% basketno %]"; + } + } + //]]> [% ELSE %] @@ -160,7 +167,7 @@ [% ELSE %]
    - [% UNLESS ( confirm_close ) %] + [% IF !confirm_close && !edi_confirm %] [% UNLESS ( selectbasketg ) %] [% UNLESS ( closedate ) %]
    @@ -176,6 +183,9 @@
    [% END %]
    Export this basket as CSV
    + [% IF ediaccount %] +
    Create edifact order
    + [% END %]
    [% END %] +[% IF edi_confirm %] +
    + +
    +

    Are you sure you want to generate an edifact order and close basket [% basketname|html %]?

    + [% IF CAN_user_acquisition_group_manage %] +

    + + +

    + [% END %] + + + + + + + + +
    +
    + [% END %] [% END %][%# IF (cannot_manage_basket) %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt index 74bedcb..7d16f00 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/basketgroup.tt @@ -144,6 +144,7 @@ function submitForm(form) {
    Reopen this basket group
    Export this basket group as CSV
    Print this basket group in PDF
    +
    Generate edifact order
    [% ELSE %]
    Delete basket group
    @@ -380,6 +381,7 @@ function submitForm(form) {
    +
    [% END %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt new file mode 100644 index 0000000..bd30e08 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edi_ean.tt @@ -0,0 +1,38 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Acquisitions › Basket ([% basketno %]) +[% INCLUDE 'doc-head-close.inc' %] + + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'acquisitions-search.inc' %] + + + +
    + +
    +
    +
    + +

    Identify the branch account submitting the EDI order

    +
    +
    +

    Select ordering branch account:

    + +
    + + + +
    +
    +
    +
    +[% INCLUDE 'acquisitions-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt new file mode 100644 index 0000000..0ebf4aa --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edifactmsgs.tt @@ -0,0 +1,86 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Acquisitions + +[% INCLUDE 'doc-head-close.inc' %] +[% INCLUDE 'datatables.inc' %] + + + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'acquisitions-search.inc' %] + + +
    + +
    +
    +
    + + +

    Edifact Messages

    +
    + + + + + + + + + + + + + +[% FOREACH msg IN messages %] + + + + + + + + + + +[% END %] + + +
    TypeTransferredStatusVendorDetailsFilename
    [% msg.message_type %][% msg.transfer_date %][% msg.status %] + +[% msg.vendor.name %] + +[% IF msg.message_type == 'QUOTE' || msg.message_type == 'ORDERS' %] + [% IF msg.basketno %] + + Basket: [% msg.basketno.basketno %] + + [% END %] +[% ELSE %] + + + Invoices + +[% END %] +[% msg.filename %]View Message
    + +
    +
    +
    +
    +[% INCLUDE 'acquisitions-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt new file mode 100644 index 0000000..508ddc2 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/acqui/edimsg.tt @@ -0,0 +1,35 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Acquisitions › Edifact Message Display +[% INCLUDE 'doc-head-close.inc' %] + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'acquisitions-search.inc' %] + + +
    + +[% IF no_message %] +
    The requested message cannot be displayed
    +[% ELSE %] +
    +
    +
    +
      + [% FOREACH seg IN segments %] +
    • [% seg | html %]
      • + [% END %] +
    +[% END %] + +
    +
    +
    +[% INCLUDE 'acquisitions-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt index 02bc60a..2a976ba 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/admin-home.tt @@ -91,6 +91,10 @@
    Funds
    Define funds within your budgets
    +
    EDI Accounts
    +
    Manage vendor EDI accounts for import/export
    +
    EDI EANs
    +
    Manage Branch EDI EANs
    diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt new file mode 100644 index 0000000..593b782 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_accounts.tt @@ -0,0 +1,265 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Administration › EDI accounts +[% IF acct_form %] + [% IF account %] + ’ Modify account + [% ELSE %] + ’ Add new account + [% END %] +[% END %] +[% IF delete_confirm %] + ’ Confirm deletion of account +[% END %] + +[% INCLUDE 'doc-head-close.inc' %] + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'cat-search.inc' %] + + + +
    + +
    +
    +
    +[% IF display %] + +[% END %] + +[% IF acct_form %] +
    + + [% IF account %] + + [% END %] +
    + + [% IF account %] + Modify account + [% ELSE %] + New account + [% END %] + + +
      +
    1. + + +
      2. +
    2. + + +
      3. +
    3. + [% transport_types = [ + 'FTP', 'SFTP', 'FILE' + ] + %] + + +
      4. +
    4. + + +
      5. +
    5. + + +
      6. +
    6. + + +
      7. +
    7. + + +
      8. +
    8. + + +
      9. +
    9. + + +
      10. +
    10. + + +
      11. +
    11. + + +
      12. +
    12. + + +
      13. +
    13. + + +
      14. +
    +
    + +
    + + Cancel +
    +
    + +[% END %] +[% IF delete_confirm %] +
    +

    Delete this account?

    + + + + + + + + + + + + + + + + + +
    Vendor[% account.vendor %]
    Description[% account.description %]
    SAN[% account.san %]
    Last activity[% account.last_activity %]
    +
    + +
    + + + +
    +
    + +
    +[% END %] +[% IF display %] +

    Vendor EDI accounts

    + + + + + + + + + + + + + + + + + + + + + [% FOREACH account IN ediaccounts %] + [% IF loop.even %] + [% ELSE %] + [% END %] + + + + + + + + + + + + [% IF account.quotes_enabled %] + + [% ELSE %] + + [% END %] + [% IF account.orders_enabled %] + + [% ELSE %] + + [% END %] + [% IF account.invoices_enabled %] + + [% ELSE %] + + [% END %] + + + + [% END %] +
    IDVendorDescriptionTransportRemote hostUsernamePasswordDownload DirectoryUpload Directoryid_code_typeid_codeQuotesOrdersInvoicesLast activityActions
    [% account.id %][% account.vendor.name %][% account.description %][% account.transport %][% account.host %][% account.username %][% IF account.password %]xxxxx[% END %][% account.download_directory %][% account.upload_directory %][% account.id_code_qualifier %][% account.san %]YYY[% account.last_activity %] + Edit | Delete +
    +[% END %] + +
    +
    +
    + [% INCLUDE 'admin-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt new file mode 100644 index 0000000..9e479d0 --- /dev/null +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/admin/edi_ean_accounts.tt @@ -0,0 +1,153 @@ +[% INCLUDE 'doc-head-open.inc' %] +Koha › Administration › EDI EANs +[% IF ean_form %] + [% IF ean %] + ’ Modify branch EAN + [% ELSE %] + ’ Add new branch EAN + [% END %] +[% END %] +[% IF delete_confirm %] + ’ Confirm deletion of EAN +[% END %] + +[% INCLUDE 'doc-head-close.inc' %] + + +[% INCLUDE 'header.inc' %] +[% INCLUDE 'cat-search.inc' %] + + + +
    + +
    +
    +
    +[% IF display %] + +[% END %] + +[% IF ean_form %] +
    + + [% IF ean %] + + + [% END %] +
    + + [% IF ean %] + Modify EAN + [% ELSE %] + New EAN + [% END %] + + +
      +
    1. + + +
      2. +
    2. + + +
      3. +
    3. +
    +
    + +[% END %] +[% IF delete_confirm %] +
    +

    Delete EAN [% ean.ean %] for branch [% ean.branch.branchname %]?

    +
    + + + + +
    +
    + +
    +
    +[% END %] +[% IF display %] +

    Branch EANs

    + + + + + + + + [% FOREACH ean IN eans %] + [% IF loop.even %] + [% ELSE %] + [% END %] + + + + + + [% END %] +
    BranchEANCode TypeActions
    [% ean.branch.branchname %][% ean.ean %][% ean.id_code_qualifier %] + Edit | Delete
    +[% END %] + +
    +
    +
    + [% INCLUDE 'admin-menu.inc' %] +
    +
    +[% INCLUDE 'intranet-bottom.inc' %] diff --git a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt index a87857c..e39369f 100644 --- a/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt +++ b/koha-tmpl/intranet-tmpl/prog/en/modules/tools/tools-home.tt @@ -107,6 +107,11 @@
    Use tool plugins
    [% END %] + [% IF CAN_user_acquisition_edi_manage %] +
    EDIfact messages
    +
    Manage EDIfact transmissions
    + [% END %] +
    diff --git a/misc/cronjobs/edi_cron.pl b/misc/cronjobs/edi_cron.pl new file mode 100755 index 0000000..587aa6f --- /dev/null +++ b/misc/cronjobs/edi_cron.pl @@ -0,0 +1,111 @@ +#!/usr/bin/perl +# +# Copyright 2013,2014 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 2 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use warnings; +use strict; + +# Handles all the edi processing for a site +# loops through the vendor_edifact records and uploads and downloads +# edifact files id the appropriate type is enabled +# downloaded quotes and invoices are processed here +# can be run as frequently as required + +use C4::Context; +use Log::Log4perl qw(:easy); +use Koha::Database; +use Koha::EDI qw( process_quote process_invoice); +use Koha::Edifact::Transport; + +my $logdir = C4::Context->logdir; + +# logging set to trace as this may be what you +# want on implementation +Log::Log4perl->easy_init( + { + level => $TRACE, + file => ">>$logdir/editrace.log", + } +); + +my $schema = Koha::Database->new()->schema(); + +my @edi_accts = $schema->resultset('VendorEdiAccount')->all(); + +my $logger = Log::Log4perl->get_logger(); + +for my $acct (@edi_accts) { + if ( $acct->quotes_enabled ) { + my $downloader = Koha::Edifact::Transport->new( $acct->id ); + $downloader->download_messages('QUOTE'); + + #update vendor last activity + } + + if ( $acct->invoices_enabled ) { + my $downloader = Koha::Edifact::Transport->new( $acct->id ); + $downloader->download_messages('INVOICE'); + + #update vendor last activity + } + if ( $acct->orders_enabled ) { + + # select pending messages + my @pending_orders = $schema->resultset('EdifactMessage')->search( + { + message_type => 'ORDERS', + vendor_id => $acct->vendor_id, + status => 'Pending', + } + ); + my $uploader = Koha::Edifact::Transport->new( $acct->id ); + $uploader->upload_messages(@pending_orders); + } +} + +# process any downloaded quotes + +my @downloaded_quotes = $schema->resultset('EdifactMessage')->search( + { + message_type => 'QUOTE', + status => 'new', + } +)->all; + +foreach my $quote_file (@downloaded_quotes) { + my $filename = $quote_file->filename; + $logger->trace("Processing quote $filename"); + process_quote($quote_file); +} + +# process any downloaded invoices + +my @downloaded_invoices = $schema->resultset('EdifactMessage')->search( + { + message_type => 'INVOICE', + status => 'new', + } +)->all; + +foreach my $invoice (@downloaded_invoices) { + my $filename = $invoice->filename(); + $logger->trace("Processing invoice $filename"); + process_invoice($invoice); +} + +exit 0; diff --git a/t/BLSINV337023.CEI b/t/BLSINV337023.CEI new file mode 100644 index 0000000..f8cdacf --- /dev/null +++ b/t/BLSINV337023.CEI @@ -0,0 +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' \ No newline at end of file diff --git a/t/EdiInvoice.t b/t/EdiInvoice.t new file mode 100755 index 0000000..4527341 --- /dev/null +++ b/t/EdiInvoice.t @@ -0,0 +1,75 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 19; + +BEGIN { use_ok('Koha::Edifact') } + +my $invoice_file = "$Bin/BLSINV337023.CEI"; + +my $invoice = Koha::Edifact->new( { filename => $invoice_file, } ); + +isa_ok( $invoice, 'Koha::Edifact' ); +my $x = $invoice->interchange_header('sender'); +my $control_reference = '337023'; +is( $x, '5013546025078', "sender returned" ); + +$x = $invoice->interchange_header('recipient'); +is( $x, '5013546121974', "recipient returned" ); +$x = $invoice->interchange_header('datetime'); +is( $x->[0], '140729', "datetime returned" ); +$x = $invoice->interchange_header('interchange_control_reference'); +is( $x, $control_reference, "interchange_control_reference returned" ); + +$x = $invoice->interchange_header('application_reference'); +is( $x, 'INVOIC', "application_reference returned" ); +$x = $invoice->interchange_trailer('interchange_control_count'); +is( $x, 6, "interchange_control_count returned" ); + +my $messages = $invoice->message_array(); + +# check inv number from BGM + +my $msg_count = @{$messages}; +is( $msg_count, 6, 'correct message count returned' ); + +is( $messages->[0]->message_type, 'INVOIC', 'Message shows correct type' ); + +my $expected_date = '20140729'; +is( $messages->[0]->message_date, + $expected_date, 'Message date correctly returned' ); +is( $messages->[0]->tax_point_date, + $expected_date, 'Tax point date correctly returned' ); + +my $expected_invoicenumber = '01975490'; + +my $invoicenumber = $messages->[1]->docmsg_number(); + +is( $messages->[0]->buyer_ean, '5013546121974', 'Buyer ean correct' ); +is( $messages->[0]->supplier_ean, '5013546025078', 'Supplier ean correct' ); + +is( $invoicenumber, $expected_invoicenumber, + 'correct invoicenumber extracted' ); + +my $lines = $messages->[1]->lineitems(); + +my $num_lines = @{$lines}; + +is( $num_lines, 8, "Correct number of lineitems returned" ); + +# sample invoice was from an early version where order was formatted basketno/ordernumber +my $expected_ordernumber = '2818/74593'; + +my $ordernumber = $lines->[7]->ordernumber; + +is( $ordernumber, $expected_ordernumber, 'correct ordernumber returned' ); + +my $lineprice = $lines->[7]->price_net; + +is( $lineprice, 4.55, 'correct net line price returned' ); + +my $tax = $lines->[7]->tax; + +is( $tax, 0, 'correct tax amount returned' ); diff --git a/t/Edifact.t b/t/Edifact.t new file mode 100755 index 0000000..104b39c --- /dev/null +++ b/t/Edifact.t @@ -0,0 +1,90 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 27; + +BEGIN { use_ok('Koha::Edifact') } + +my $filename = "$Bin/prquotes_73050_20140430.CEQ"; + +my $quote = Koha::Edifact->new( { filename => $filename, } ); + +isa_ok( $quote, 'Koha::Edifact' ); + +my $x = $quote->interchange_header('sender'); +is( $x, '5013546027856', "sender returned" ); + +$x = $quote->interchange_header('recipient'); +is( $x, '5030670137480', "recipient returned" ); +$x = $quote->interchange_header('datetime'); +is( $x->[0], '140430', "datetime returned" ); +my $control_reference = 'EDIQ2857763'; +$x = $quote->interchange_header('interchange_control_reference'); +is( $x, $control_reference, "interchange_control_reference returned" ); + +$x = $quote->interchange_header('application_reference'); +is( $x, 'QUOTES', "application_reference returned" ); + +$x = $quote->interchange_trailer('interchange_control_count'); +is( $x, 1, "interchange_control_count returned" ); + +my $msgs = $quote->message_array(); +my $msg_count = @{$msgs}; +is( $msg_count, 1, "correct message count returned" ); +my $m = $msgs->[0]; + +is( $m->message_type, 'QUOTES', "Message shows correct type" ); +is( $m->message_reference_number, + 'MQ09791', "Message reference number returned" ); +is( $m->docmsg_number, 'Q741588', "Message docmsg number returned" ); +is( $m->message_date, '20140430', "Message date returned" ); + +my $lin = $m->lineitems(); + +my $num_lines = @{$lin}; +is( $num_lines, 18, 'Correct number of lines in message' ); + +my $test_line = $lin->[-1]; + +is( $test_line->line_item_number, 18, 'correct line number returned' ); +is( $test_line->item_number_id, '9780273761006', 'correct ean returned' ); +is( $test_line->quantity, 1, 'quantity returned' ); + +my $test_title = 'International business [electronic resource]'; +my $marcrec = $test_line->marc_record; +isa_ok( $marcrec, 'MARC::Record' ); + +my $title = $test_line->title(); + +# also tests components are concatenated +is( $title, $test_title, "Title returned" ); + +# problems currently with the record (needs leader ??) +#is( $marcrec->title(), $test_title, "Title returned from marc"); +my $test_author = q{Rugman, Alan M.}; +is( $test_line->author, $test_author, "Author returned" ); +is( $test_line->publisher, 'Pearson Education', "Publisher returned" ); +is( $test_line->publication_date, q{2012.}, "Pub. date returned" ); +# +# Test data encoded in GIR +# +my $stock_category = $test_line->girfield('stock_category'); +is( $stock_category, 'EBOOK', "stock_category returned" ); +my $branch = $test_line->girfield('branch'); +is( $branch, 'ELIB', "branch returned" ); +my $fund_allocation = $test_line->girfield('fund_allocation'); +is( $fund_allocation, '660BOO_2013', "fund_allocation returned" ); +my $collection_code = $test_line->girfield('collection_code'); +is( $collection_code, 'EBOO', "collection_code returned" ); + +#my $shelfmark = $test_line->girfield('shelfmark'); +#my $classification = $test_line->girfield('classification'); + +## text the free_text returned from the line +my $test_line_2 = $lin->[12]; + +my $ftx_string = 'E*610.72* - additional items'; + +is( $test_line_2->free_text, $ftx_string, "ftx note retrieved" ); diff --git a/t/Ediorder.t b/t/Ediorder.t new file mode 100755 index 0000000..5332f0c --- /dev/null +++ b/t/Ediorder.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl +use strict; +use warnings; +use FindBin qw( $Bin ); + +use Test::More tests => 6; + +BEGIN { use_ok('Koha::Edifact::Order') } + + +# The following tests are for internal methods but they could +# error spectacularly so yest +# Check that quoting is done correctly +# +my $processed_text = + Koha::Edifact::Order::encode_text(q{string containing ?,',:,+}); + +cmp_ok( + $processed_text, 'eq', + q{string containing ??,?',?:,?+}, + 'Outgoing text correctly quoted' +); + +# extend above test to test chunking in imd_segment +# +my $code = '010'; +my $data_to_encode = $processed_text; + +my @segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); + +my $testseg = "IMD+L+010+:::$processed_text"; +$testseg .= q{'}; # add segment terminator + +cmp_ok( $segs[0], 'eq', $testseg, 'IMD segment correctly formed' ); + +$data_to_encode = 'A' x 35; +$data_to_encode .= 'B' x 35; +$data_to_encode .= 'C' x 10; + +@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); + +cmp_ok( + $segs[0], + 'eq', +q{IMD+L+010+:::AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA:BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB'}, + 'IMD segment correctly chunked' +); +cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC'}, + 'IMD segment correctly split across segments' ); + +$data_to_encode .= '??'; + +# this used to cause an infinite loop +@segs = Koha::Edifact::Order::imd_segment( $code, $data_to_encode ); +cmp_ok( $segs[1], 'eq', q{IMD+L+010+:::CCCCCCCCCC??'}, + 'IMD segment deals with quoted character at end' ); diff --git a/t/prquotes_73050_20140430.CEQ b/t/prquotes_73050_20140430.CEQ new file mode 100644 index 0000000..c5adba1 --- /dev/null +++ b/t/prquotes_73050_20140430.CEQ @@ -0,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' \ No newline at end of file -- 2.1.0